Theory ReduceStoreBuffer
theory ReduceStoreBuffer
imports Main
begin
subsection ‹Memory Instructions›
type_synonym addr = nat
type_synonym val = nat
type_synonym tmp = nat
type_synonym tmps = "tmp ⇒ val option"
type_synonym sop = "tmp set × (tmps ⇒ val)"
locale valid_sop =
fixes sop :: "sop"
assumes valid_sop: "⋀D f θ.
⟦sop=(D,f); D ⊆ dom θ⟧
⟹
f θ = f (θ|`D)"
type_synonym memory = "addr ⇒ val"
type_synonym owns = "addr set"
type_synonym rels = "addr ⇒ bool option"
type_synonym shared = "addr ⇒ bool option"
type_synonym acq = "addr set"
type_synonym rel = "addr set"
type_synonym lcl = "addr set"
type_synonym wrt = "addr set"
type_synonym cond = "tmps ⇒ bool"
type_synonym ret = "val ⇒ val ⇒ val"
datatype instr = Read bool addr tmp
| Write bool addr sop acq lcl rel wrt
| RMW addr tmp sop cond ret acq lcl rel wrt
| Fence
| Ghost acq lcl rel wrt
type_synonym instrs = "instr list"
type_synonym ('p,'sb,'dirty,'owns,'rels) thread_config =
"'p × instrs × tmps × 'sb × 'dirty × 'owns × 'rels"
type_synonym ('p,'sb,'dirty,'owns,'rels,'shared) global_config =
"('p,'sb,'dirty,'owns,'rels) thread_config list × memory × 'shared "
definition "owned t = (let (p,instrs,θ,sb,𝒟,𝒪,ℛ) = t in 𝒪)"
lemma owned_simp [simp]: "owned (p,instrs,θ,sb,𝒟,𝒪,ℛ) = (𝒪)"
by (simp add: owned_def)
definition "𝒪_sb t = (let (p,instrs,θ,sb,𝒟,𝒪,ℛ) = t in (𝒪,sb))"
lemma 𝒪_sb_simp [simp]: "𝒪_sb (p,instrs,θ,sb,𝒟,𝒪,ℛ) = (𝒪,sb)"
by (simp add: 𝒪_sb_def)
definition "released t = (let (p,instrs,θ,sb,𝒟,𝒪,ℛ) = t in ℛ)"
lemma released_simp [simp]: "released (p,instrs,θ,sb,𝒟,𝒪,ℛ) = (ℛ)"
by (simp add: released_def)
lemma list_update_id': "v = xs ! i ⟹ xs[i := v] = xs"
by simp
lemmas converse_rtranclp_induct5 =
converse_rtranclp_induct [where a="(m,sb,𝒪,ℛ,𝒮)" and b="(m',sb',𝒪',ℛ',𝒮')", split_rule,consumes 1, case_names refl step]
subsection ‹Abstract Program Semantics›
locale memory_system =
fixes
memop_step :: "(instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared) ⇒
(instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared) ⇒ bool"
("_ →⇩m _" [60,60] 100) and
storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared) ⇒ (memory × 'sb × 'owns × 'rels × 'shared) ⇒ bool" ("_ →⇩s⇩b _" [60,60] 100)
locale program =
fixes
program_step :: "tmps ⇒ 'p ⇒ 'p × instrs ⇒ bool" ("_⊢ _ →⇩p _" [60,60,60] 100)
locale computation = memory_system + program +
constrains
storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared) ⇒ (memory × 'sb × 'owns × 'rels × 'shared) ⇒ bool" and
memop_step :: "
(instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared) ⇒
(instrs × tmps × 'sb × memory × 'dirty × 'owns × 'rels × 'shared) ⇒ bool"
and
program_step :: "tmps ⇒ 'p ⇒ 'p × instrs ⇒ bool"
fixes
"record" :: "'p ⇒ 'p ⇒ instrs ⇒ 'sb ⇒ 'sb"
begin
inductive concurrent_step ::
"('p,'sb,'dirty,'owns,'rels,'shared) global_config ⇒ ('p,'sb,'dirty,'owns,'rels,'shared) global_config ⇒ bool"
("_ ⇒ _" [60,60] 100)
where
Program:
"⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
θ⊢p →⇩p (p',is') ⟧ ⟹
(ts,m,𝒮) ⇒ (ts[i:=(p',is@is',θ,record p p' is' sb,𝒟,𝒪,ℛ)],m,𝒮)"
| Memop:
"⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩m (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮') ⟧
⟹
(ts,m,𝒮) ⇒ (ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')],m',𝒮')"
| StoreBuffer:
"⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
(m,sb,𝒪,ℛ,𝒮) →⇩s⇩b (m',sb',𝒪',ℛ',𝒮') ⟧ ⟹
(ts,m,𝒮) ⇒ (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')],m',𝒮')"
definition final:: "('p,'sb,'dirty,'owns,'rels,'shared) global_config ⇒ bool"
where
"final c = (¬ (∃c'. c ⇒ c'))"
lemma store_buffer_steps:
assumes sb_step: "storebuffer_step^** (m,sb,𝒪,ℛ,𝒮) (m',sb',𝒪',ℛ',𝒮')"
shows "⋀ts. i < length ts ⟹ ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟹
concurrent_step^** (ts,m,𝒮) (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')],m',𝒮')"
using sb_step
proof (induct rule: converse_rtranclp_induct5)
case refl then show ?case
by (simp add: list_update_id')
next
case (step m sb 𝒪 ℛ 𝒮 m'' sb'' 𝒪'' ℛ'' 𝒮'')
note i_bound = ‹i < length ts›
note ts_i = ‹ts ! i = (p, is, θ, sb, 𝒟, 𝒪, ℛ)›
note step = ‹(m, sb,𝒪,ℛ,𝒮) →⇩s⇩b (m'', sb'',𝒪'',ℛ'',𝒮'')›
let ?ts' = "ts[i := (p, is, θ, sb'',𝒟, 𝒪'',ℛ'')]"
from StoreBuffer [OF i_bound ts_i step]
have "(ts, m, 𝒮) ⇒ (?ts', m'', 𝒮'')".
also
from i_bound have i_bound': "i < length ?ts'" by simp
from i_bound have ts'_i: "?ts'!i = (p,is,θ,sb'',𝒟,𝒪'',ℛ'')"
by simp
from step.hyps (3) [OF i_bound' ts'_i] i_bound
have "concurrent_step⇧*⇧* (?ts', m'', 𝒮'') (ts[i := (p, is, θ, sb',𝒟, 𝒪',ℛ')], m', 𝒮')"
by (simp)
finally
show ?case .
qed
lemma step_preserves_length_ts:
assumes step: "(ts,m,𝒮) ⇒ (ts',m',𝒮')"
shows "length ts' = length ts"
using step
apply (cases)
apply auto
done
end
lemmas concurrent_step_cases = computation.concurrent_step.cases
[cases set, consumes 1, case_names Program Memop StoreBuffer]
definition augment_shared:: "shared ⇒ addr set ⇒ addr set ⇒ shared" ("_ ⊕⇘_⇙ _" [61,1000,60] 61)
where
"𝒮 ⊕⇘W⇙ S ≡ (λa. if a ∈ S then Some (a ∈ W) else 𝒮 a)"
definition restrict_shared:: "shared ⇒ addr set ⇒ addr set ⇒ shared" ("_ ⊖⇘_⇙ _" [51,1000,50] 51)
where
"𝒮 ⊖⇘A⇙ L ≡ (λa. if a ∈ L then None
else (case 𝒮 a of None ⇒ None
| Some writeable ⇒ Some (a ∈ A ∨ writeable)))"
definition read_only :: "shared ⇒ addr set"
where
"read_only 𝒮 ≡ {a. (𝒮 a = Some False)}"
definition shared_le:: "shared ⇒ shared ⇒ bool" (infix "⊆⇩s" 50)
where
"m⇩1 ⊆⇩s m⇩2 ≡ m⇩1 ⊆⇩m m⇩2 ∧ read_only m⇩1 ⊆ read_only m⇩2"
lemma shared_leD: "m⇩1 ⊆⇩s m⇩2 ⟹ m⇩1 ⊆⇩m m⇩2 ∧ read_only m⇩1 ⊆ read_only m⇩2"
by (simp add: shared_le_def)
lemma shared_le_map_le: "m⇩1 ⊆⇩s m⇩2 ⟹ m⇩1 ⊆⇩m m⇩2"
by (simp add: shared_le_def)
lemma shared_le_read_only_le: "m⇩1 ⊆⇩s m⇩2 ⟹ read_only m⇩1 ⊆ read_only m⇩2"
by (simp add: shared_le_def)
lemma dom_augment [simp]: "dom (m ⊕⇘W⇙ S) = dom m ∪ S"
by (auto simp add: augment_shared_def)
lemma augment_empty [simp]: "S ⊕⇘x⇙ {} = S"
by (simp add: augment_shared_def)
lemma inter_neg [simp]: "X ∩ - L = X - L"
by blast
lemma dom_restrict_shared [simp]: "dom (m ⊖⇘A⇙ L) = dom m - L"
by (auto simp add: restrict_shared_def split: option.splits)
lemma restrict_shared_UNIV [simp]: "(m ⊖⇘A⇙ UNIV) = Map.empty"
by (auto simp add: restrict_shared_def split: if_split_asm option.splits)
lemma restrict_shared_empty [simp]: "(Map.empty ⊖⇘A⇙ L) = Map.empty"
apply (rule ext)
by (auto simp add: restrict_shared_def split: if_split_asm option.splits)
lemma restrict_shared_in [simp]: "a ∈ L ⟹ (m ⊖⇘A⇙ L) a = None"
by (auto simp add: restrict_shared_def split: if_split_asm option.splits)
lemma restrict_shared_out: "a ∉ L ⟹ (m ⊖⇘A⇙ L) a =
map_option (λwriteable. (a ∈ A ∨ writeable)) (m a)"
by (auto simp add: restrict_shared_def split: if_split_asm option.splits)
lemma restrict_shared_out'[simp]:
"a ∉ L ⟹ m a = Some writeable ⟹ (m ⊖⇘A⇙ L) a = Some (a ∈ A ∨ writeable)"
by (simp add: restrict_shared_out)
lemma augment_mono_map': "A ⊆⇩m B ⟹ (A ⊕⇘x⇙ C) ⊆⇩m (B ⊕⇘x⇙ C)"
by (auto simp add: augment_shared_def map_le_def domIff)
lemma augment_mono_map: "A ⊆⇩s B ⟹ (A ⊕⇘x⇙ C) ⊆⇩s (B ⊕⇘x⇙ C)"
by (auto simp add: augment_shared_def shared_le_def map_le_def read_only_def dom_def split: option.splits if_split_asm)
lemma restrict_mono_map: "A ⊆⇩s B ⟹ (A ⊖⇘x⇙ C) ⊆⇩s (B ⊖⇘x⇙ C)"
by (auto simp add: restrict_shared_def shared_le_def map_le_def read_only_def dom_def split: option.splits if_split_asm)
lemma augment_mono_aux: "dom A ⊆ dom B ⟹ dom (A ⊕⇘x⇙ C) ⊆ dom (B ⊕⇘x⇙ C)"
by auto
lemma restrict_mono_aux: "dom A ⊆ dom B ⟹ dom (A ⊖⇘x⇙ C) ⊆ dom (B ⊖⇘x⇙ C)"
by auto
lemma read_only_mono: "S ⊆⇩m S' ⟹ a ∈ read_only S ⟹ a ∈ read_only S'"
by (auto simp add: map_le_def domIff read_only_def dest!: bspec)
lemma in_read_only_restrict_conv:
"a ∈ read_only (𝒮 ⊖⇘A⇙ L) = (a ∈ read_only 𝒮 ∧ a ∉ L ∧ a ∉ A)"
by (auto simp add: read_only_def restrict_shared_def split: option.splits if_split_asm)
lemma in_read_only_augment_conv: "a ∈ read_only (𝒮 ⊕⇘W⇙ R) = (if a ∈ R then a ∉ W else a ∈ read_only 𝒮)"
by (auto simp add: read_only_def augment_shared_def)
lemmas in_read_only_convs = in_read_only_restrict_conv in_read_only_augment_conv
lemma read_only_dom: "read_only 𝒮 ⊆ dom 𝒮"
by (auto simp add: read_only_def dom_def)
lemma read_only_empty [simp]: "read_only Map.empty = {}"
by (auto simp add: read_only_def)
lemma restrict_shared_fuse: "S ⊖⇘A⇙ L ⊖⇘B⇙ M = (S ⊖⇘(A ∪ B)⇙ (L ∪ M))"
apply (rule ext)
apply (auto simp add: restrict_shared_def split: option.splits if_split_asm)
done
lemma restrict_shared_empty_set [simp]: "S ⊖⇘{}⇙ {} = S"
apply (rule ext)
apply (auto simp add: restrict_shared_def split: option.splits if_split_asm)
done
definition augment_rels:: "addr set ⇒ addr set ⇒ rels ⇒ rels"
where
"augment_rels S R ℛ = (λa. if a ∈ R
then (case ℛ a of
None ⇒ Some (a ∈ S)
| Some s ⇒ Some (s ∧ (a ∈ S)))
else ℛ a)"
declare domIff [iff del]
subsection ‹Memory Transitions›
locale gen_direct_memop_step =
fixes emp::'rels and aug::"owns ⇒ rel ⇒ 'rels ⇒ 'rels"
begin
inductive gen_direct_memop_step :: "(instrs × tmps × unit × memory × bool × owns × 'rels × shared ) ⇒
(instrs × tmps × unit × memory × bool × owns × 'rels × shared ) ⇒ bool"
("_ → _" [60,60] 100)
where
Read: "(Read volatile a t # is,θ, x, m,𝒟, 𝒪, ℛ, 𝒮) →
(is, θ (t↦m a), x, m, 𝒟, 𝒪, ℛ, 𝒮)"
| WriteNonVolatile:
"(Write False a (D,f) A L R W#is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) →
(is, θ, x, m(a := f θ), 𝒟, 𝒪, ℛ, 𝒮)"
| WriteVolatile:
"(Write True a (D,f) A L R W# is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) →
(is, θ, x, m(a:=f θ), True, 𝒪 ∪ A - R, emp, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
| Fence:
"(Fence # is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) → (is, θ,x, m, False, 𝒪, emp, 𝒮)"
| RMWReadOnly:
"⟦¬ cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W # is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) → (is, θ(t↦m a),x,m, False, 𝒪, emp, 𝒮)"
| RMWWrite:
"⟦cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) →
(is, θ(t↦ret (m a) (f(θ(t↦m a)))),x, m(a:= f(θ(t↦m a))), False,𝒪 ∪ A - R, emp, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
| Ghost:
"(Ghost A L R W # is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) →
(is, θ, x, m, 𝒟, 𝒪 ∪ A - R, aug (dom 𝒮) R ℛ , 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
end
interpretation direct_memop_step: gen_direct_memop_step Map.empty augment_rels .
term direct_memop_step.gen_direct_memop_step
abbreviation direct_memop_step :: "(instrs × tmps × unit × memory × bool × owns × rels × shared ) ⇒
(instrs × tmps × unit × memory × bool × owns × rels × shared ) ⇒ bool"
("_ → _" [60,60] 100)
where
"direct_memop_step ≡ direct_memop_step.gen_direct_memop_step"
term "x → Y"
abbreviation direct_memop_steps :: "
(instrs × tmps × unit × memory × bool × owns × rels × shared ) ⇒
(instrs × tmps × unit × memory × bool × owns × rels × shared )
⇒ bool"
("_ →⇧* _" [60,60] 100)
where
"direct_memop_steps == (direct_memop_step)^**"
term "x →⇧* Y"
interpretation virtual_memop_step: gen_direct_memop_step "()" "(λS R ℛ. ())" .
abbreviation virtual_memop_step :: "(instrs × tmps × unit × memory × bool × owns × unit × shared ) ⇒
(instrs × tmps × unit × memory × bool × owns × unit × shared ) ⇒ bool"
("_ →⇩v _" [60,60] 100)
where
"virtual_memop_step ≡ virtual_memop_step.gen_direct_memop_step"
term "x →⇩v Y"
abbreviation virtual_memop_steps :: "
(instrs × tmps × unit × memory × bool × owns × unit × shared ) ⇒
(instrs × tmps × unit × memory × bool × owns × unit × shared )
⇒ bool"
("_ →⇩v⇧* _" [60,60] 100)
where
"virtual_memop_steps == (virtual_memop_step)^**"
term "x →⇧* Y"
lemma virtual_memop_step_simulates_direct_memop_step:
assumes step:
"(is, θ, x, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', x', m', 𝒟', 𝒪', ℛ', 𝒮')"
shows "(is, θ, x, m, 𝒟, 𝒪, (), 𝒮) →⇩v (is', θ', x', m', 𝒟', 𝒪', (), 𝒮')"
using step
apply (cases)
apply (auto intro: virtual_memop_step.gen_direct_memop_step.intros)
done
subsection ‹Safe Configurations of Virtual Machines›
inductive safe_direct_memop_state :: "owns list ⇒ nat ⇒
(instrs × tmps × memory × bool × owns × shared) ⇒ bool "
("_,_⊢ _ √" [60,60,60] 100)
where
Read: "⟦a ∈ 𝒪 ∨ a ∈ read_only 𝒮 ∨ (volatile ∧ a ∈ dom 𝒮);
volatile ⟶ ¬ 𝒟 ⟧
⟹
𝒪s,i⊢(Read volatile a t # is, θ, m, 𝒟, 𝒪, 𝒮)√"
| WriteNonVolatile:
"⟦a ∈ 𝒪; a ∉ dom 𝒮⟧
⟹
𝒪s,i⊢(Write False a (D,f) A L R W#is, θ, m, 𝒟, 𝒪, 𝒮)√"
| WriteVolatile:
"⟦∀j < length 𝒪s. i≠j ⟶ a ∉ 𝒪s!j;
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ 𝒪s!j = {};
a ∉ read_only 𝒮⟧
⟹
𝒪s,i⊢(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Fence:
"𝒪s,i⊢(Fence # is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Ghost:
"⟦A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ 𝒪s!j = {}⟧
⟹
𝒪s,i⊢(Ghost A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| RMWReadOnly:
"⟦¬ cond (θ(t↦m a)); a ∈ 𝒪 ∨ a ∈ dom 𝒮⟧ ⟹
𝒪s,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| RMWWrite:
"⟦cond (θ(t↦m a));
∀j < length 𝒪s. i≠j ⟶ a ∉ 𝒪s!j;
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ 𝒪s!j = {};
a ∉ read_only 𝒮⟧
⟹
𝒪s,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Nil: "𝒪s,i⊢([], θ, m, 𝒟, 𝒪, 𝒮)√"
inductive safe_delayed_direct_memop_state :: "owns list ⇒ rels list ⇒ nat ⇒
(instrs × tmps × memory × bool × owns × shared) ⇒ bool "
("_,_,_⊢ _ √" [60,60,60,60] 100)
where
Read: "⟦a ∈ 𝒪 ∨ a ∈ read_only 𝒮 ∨ (volatile ∧ a ∈ dom 𝒮);
∀j < length 𝒪s. i≠j ⟶ (ℛs!j) a ≠ Some False;
¬ volatile ⟶ (∀j < length 𝒪s. i≠j ⟶ a ∉ dom (ℛs!j));
volatile ⟶ ¬ 𝒟 ⟧
⟹
𝒪s,ℛs,i⊢(Read volatile a t # is, θ, m, 𝒟, 𝒪, 𝒮)√"
| WriteNonVolatile:
"⟦a ∈ 𝒪; a ∉ dom 𝒮; ∀j < length 𝒪s. i≠j ⟶ a ∉ dom (ℛs!j)⟧
⟹
𝒪s,ℛs,i⊢(Write False a (D,f) A L R W#is, θ, m, 𝒟, 𝒪, 𝒮)√"
| WriteVolatile:
"⟦∀j < length 𝒪s. i≠j ⟶ a ∉ (𝒪s!j ∪ dom (ℛs!j));
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ (𝒪s!j ∪ dom (ℛs!j)) = {};
a ∉ read_only 𝒮⟧
⟹
𝒪s,ℛs,i⊢(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Fence:
"𝒪s,ℛs,i⊢(Fence # is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Ghost:
"⟦A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ (𝒪s!j ∪ dom (ℛs!j)) = {}⟧
⟹
𝒪s,ℛs,i⊢(Ghost A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| RMWReadOnly:
"⟦¬ cond (θ(t↦m a)); a ∈ 𝒪 ∨ a ∈ dom 𝒮;
∀j < length 𝒪s. i≠j ⟶ (ℛs!j) a ≠ Some False ⟧
⟹
𝒪s,ℛs,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| RMWWrite:
"⟦cond (θ(t↦m a)); a ∈ 𝒪 ∨ a ∈ dom 𝒮;
∀j < length 𝒪s. i≠j ⟶ a ∉ (𝒪s!j ∪ dom (ℛs!j));
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {};
∀j < length 𝒪s. i≠j ⟶ A ∩ (𝒪s!j ∪ dom (ℛs!j)) = {};
a ∉ read_only 𝒮⟧
⟹
𝒪s,ℛs,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
| Nil: "𝒪s,ℛs,i⊢([], θ, m, 𝒟, 𝒪, 𝒮)√"
lemma memop_safe_delayed_implies_safe_free_flowing:
assumes safe_delayed: "𝒪s,ℛs,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√"
shows "𝒪s,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√"
using safe_delayed
proof (cases)
case Read thus ?thesis
by (fastforce intro!: safe_direct_memop_state.intros)
next
case WriteNonVolatile thus ?thesis
by (fastforce intro!: safe_direct_memop_state.intros)
next
case WriteVolatile thus ?thesis
by (fastforce intro!: safe_direct_memop_state.intros)
next
case Fence thus ?thesis
by (fastforce intro!: safe_direct_memop_state.intros)
next
case Ghost thus ?thesis
by (fastforce intro!: safe_direct_memop_state.Ghost)
next
case RMWReadOnly thus ?thesis
by (fastforce intro!: safe_direct_memop_state.intros)
next
case RMWWrite thus ?thesis
by (fastforce intro!: safe_direct_memop_state.RMWWrite)
next
case Nil thus ?thesis
by (fastforce intro!: safe_direct_memop_state.Nil)
qed
lemma memop_empty_rels_safe_free_flowing_implies_safe_delayed:
assumes safe: "𝒪s,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√"
assumes empty: "∀ℛ ∈ set ℛs. ℛ = Map.empty"
assumes leq: "length 𝒪s = length ℛs"
assumes unowned_shared: "(∀a. (∀i < length 𝒪s. a ∉ (𝒪s!i)) ⟶ a ∈ dom 𝒮)"
assumes Os_i: "𝒪s!i = 𝒪"
shows "𝒪s,ℛs,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√"
using safe
proof (cases)
case Read thus ?thesis
using leq empty
by (fastforce intro!: safe_delayed_direct_memop_state.Read dest: nth_mem)
next
case WriteNonVolatile thus ?thesis
using leq empty
by (fastforce intro!: safe_delayed_direct_memop_state.intros dest: nth_mem)
next
case WriteVolatile thus ?thesis
using leq empty
apply clarsimp
apply (rule safe_delayed_direct_memop_state.WriteVolatile)
apply (auto)
apply (drule nth_mem)
apply fastforce
apply (drule nth_mem)
apply fastforce
done
next
case Fence thus ?thesis
by (fastforce intro!: safe_delayed_direct_memop_state.intros)
next
case Ghost thus ?thesis
using leq empty
apply clarsimp
apply (rule safe_delayed_direct_memop_state.Ghost)
apply (auto)
apply (drule nth_mem)
apply fastforce
done
next
case RMWReadOnly thus ?thesis
using leq empty
by (fastforce intro!: safe_delayed_direct_memop_state.intros dest: nth_mem)
next
case (RMWWrite cond t a A L R D f ret W) thus ?thesis
using leq empty unowned_shared [rule_format, where a=a] Os_i
apply clarsimp
apply (rule safe_delayed_direct_memop_state.RMWWrite)
apply (auto)
apply (drule nth_mem)
apply fastforce
apply (drule nth_mem)
apply fastforce
done
next
case Nil thus ?thesis
by (fastforce intro!: safe_delayed_direct_memop_state.Nil)
qed
inductive id_storebuffer_step::
"(memory × unit × owns × rels × shared) ⇒ (memory × unit × owns × rels × shared) ⇒ bool" ("_ →⇩I _" [60,60] 100)
where
Id: "(m,x,𝒪,ℛ,𝒮) →⇩I (m,x,𝒪,ℛ,𝒮)"
definition empty_storebuffer_step:: "(memory × 'sb × 'owns × 'rels × 'shared) ⇒ (memory × 'sb × 'owns × 'rels × 'shared) ⇒ bool"
where
"empty_storebuffer_step c c' = False"
context program
begin
abbreviation direct_concurrent_step ::
"('p,unit,bool,owns,rels,shared) global_config ⇒ ('p,unit,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩d _" [100,60] 100)
where
"direct_concurrent_step ≡
computation.concurrent_step direct_memop_step.gen_direct_memop_step empty_storebuffer_step program_step
(λp p' is sb. sb)"
abbreviation direct_concurrent_steps::
"('p,unit,bool,owns,rels,shared) global_config ⇒ ('p,unit,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩d⇧* _" [60,60] 100)
where
"direct_concurrent_steps == direct_concurrent_step^**"
abbreviation virtual_concurrent_step ::
"('p,unit,bool,owns,unit,shared) global_config ⇒ ('p,unit,bool,owns,unit,shared) global_config ⇒ bool"
("_ ⇒⇩v _" [100,60] 100)
where
"virtual_concurrent_step ≡
computation.concurrent_step virtual_memop_step.gen_direct_memop_step empty_storebuffer_step program_step
(λp p' is sb. sb)"
abbreviation virtual_concurrent_steps::
"('p,unit,bool,owns,unit,shared) global_config ⇒ ('p,unit,bool,owns,unit,shared) global_config ⇒ bool"
("_ ⇒⇩v⇧* _" [60,60] 100)
where
"virtual_concurrent_steps == virtual_concurrent_step^**"
term "x ⇒⇩v Y"
term "x ⇒⇩d Y"
term "x ⇒⇩d⇧* Y"
term "x ⇒⇩v⇧* Y"
end
definition
"safe_reach step safe cfg ≡
∀ cfg'. step^** cfg cfg' ⟶ safe cfg'"
lemma safe_reach_safe_refl: "safe_reach step safe cfg ⟹ safe cfg"
apply (auto simp add: safe_reach_def)
done
lemma safe_reach_safe_rtrancl: "safe_reach step safe cfg ⟹ step^** cfg cfg' ⟹ safe cfg'"
by (simp only: safe_reach_def)
lemma safe_reach_steps: "safe_reach step safe cfg ⟹ step^** cfg cfg' ⟹ safe_reach step safe cfg'"
apply (auto simp add: safe_reach_def intro: rtranclp_trans)
done
lemma safe_reach_step: "safe_reach step safe cfg ⟹ step cfg cfg' ⟹ safe_reach step safe cfg'"
apply (erule safe_reach_steps)
apply (erule r_into_rtranclp)
done
context program
begin
abbreviation
"safe_reach_direct ≡ safe_reach direct_concurrent_step"
lemma safe_reac_direct_def':
"safe_reach_direct safe cfg ≡
∀ cfg'. cfg ⇒⇩d⇧* cfg' ⟶ safe cfg'"
by( simp add: safe_reach_def)
abbreviation
"safe_reach_virtual ≡ safe_reach virtual_concurrent_step"
lemma safe_reac_virtual_def':
"safe_reach_virtual safe cfg ≡
∀ cfg'. cfg ⇒⇩v⇧* cfg' ⟶ safe cfg'"
by( simp add: safe_reach_def)
end
definition
"safe_free_flowing cfg ≡ let (ts,m,𝒮) = cfg
in (∀i < length ts. let (p,is,θ,x,𝒟,𝒪,ℛ) = ts!i in
map owned ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√)"
lemma safeE: "⟦safe_free_flowing (ts,m,𝒮);i<length ts; ts!i=(p,is,θ,x,𝒟,𝒪,ℛ)⟧
⟹ map owned ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√"
by (auto simp add: safe_free_flowing_def)
definition
"safe_delayed cfg ≡ let (ts,m,𝒮) = cfg
in (∀i < length ts. let (p,is,θ,x,𝒟,𝒪,ℛ) = ts!i in
map owned ts,map released ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√)"
lemma safe_delayedE: "⟦safe_delayed (ts,m,𝒮);i<length ts; ts!i=(p,is,θ,x,𝒟,𝒪,ℛ)⟧
⟹ map owned ts,map released ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√"
by (auto simp add: safe_delayed_def)
definition "remove_rels ≡ map (λ(p,is,θ,sb,𝒟,𝒪,ℛ). (p,is,θ,sb,𝒟,𝒪,()))"
theorem (in program) virtual_simulates_direct_step:
assumes step: "(ts,m,𝒮) ⇒⇩d (ts',m',𝒮')"
shows "(remove_rels ts,m,𝒮) ⇒⇩v (remove_rels ts',m',𝒮')"
using step
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
interpret virtual_computation:
computation virtual_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from step show ?thesis
proof (cases)
case (Program j p "is" θ sb 𝒟 𝒪 ℛ p' is')
then obtain
ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')"
by auto
from ts_j j_bound have
vts_j: "remove_rels ts!j = (p,is,θ,sb,𝒟,𝒪,())" by (auto simp add: remove_rels_def)
from virtual_computation.Program [OF _ vts_j prog_step, of m 𝒮] j_bound ts'
show ?thesis
by (clarsimp simp add: 𝒮' m' remove_rels_def map_update)
next
case (Memop j p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
mem_step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', sb',m', 𝒟', 𝒪', ℛ', 𝒮')"
by auto
from ts_j j_bound have
vts_j: "remove_rels ts!j = (p,is,θ,sb,𝒟,𝒪,())" by (auto simp add: remove_rels_def)
from virtual_computation.Memop[OF _ vts_j virtual_memop_step_simulates_direct_memop_step [OF mem_step]] j_bound ts'
show ?thesis
by (clarsimp simp add: remove_rels_def map_update)
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
lemmas converse_rtranclp_induct_sbh_steps = converse_rtranclp_induct
[of _ "(ts,m,𝒮)" "(ts',m',𝒮')", split_rule,
consumes 1, case_names refl step]
theorem (in program) virtual_simulates_direct_steps:
assumes steps: "(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')"
shows "(remove_rels ts,m,𝒮) ⇒⇩v⇧* (remove_rels ts',m',𝒮')"
using steps
proof (induct rule: converse_rtranclp_induct_sbh_steps)
case refl thus ?case by auto
next
case (step ts m 𝒮 ts'' m'' 𝒮'')
then obtain
first: "(ts, m, 𝒮) ⇒⇩d (ts'', m'', 𝒮'')" and
hyp: "(remove_rels ts'', m'', 𝒮'') ⇒⇩v⇧* (remove_rels ts', m', 𝒮')"
by blast
note virtual_simulates_direct_step [OF first] also note hyp
finally
show ?case by blast
qed
locale simple_ownership_distinct =
fixes ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes simple_ownership_distinct:
"⋀i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j.
⟦i < length ts; j < length ts; i ≠ j;
ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i); ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)
⟧ ⟹ 𝒪⇩i ∩ 𝒪⇩j = {}"
lemma (in simple_ownership_distinct)
simple_ownership_distinct_nth_update:
"⋀i p is θ 𝒪 ℛ 𝒟 xs sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
∀j < length ts. i≠j ⟶ (let (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j) = ts!j
in (𝒪') ∩ (𝒪⇩j) ={}) ⟧ ⟹
simple_ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
apply (unfold_locales)
apply (clarsimp simp add: nth_list_update split: if_split_asm)
apply (force dest: simple_ownership_distinct simp add: Let_def)
apply (fastforce dest: simple_ownership_distinct simp add: Let_def)
apply (fastforce dest: simple_ownership_distinct simp add: Let_def)
done
locale read_only_unowned =
fixes 𝒮::shared and ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes read_only_unowned:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
𝒪 ∩ read_only 𝒮 = {}"
lemma (in read_only_unowned)
read_only_unowned_nth_update:
"⋀i p is 𝒪 ℛ 𝒟 acq θ sb.
⟦i < length ts; 𝒪 ∩ read_only 𝒮 = {}⟧ ⟹
read_only_unowned 𝒮 (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
apply (unfold_locales)
apply (auto dest: read_only_unowned
simp add: nth_list_update split: if_split_asm)
done
locale unowned_shared =
fixes 𝒮::shared and ts::"('p,'sb,'dirty,owns,'rels) thread_config list"
assumes unowned_shared: "- ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts) ⊆ dom 𝒮"
lemma (in unowned_shared)
unowned_shared_nth_update:
assumes i_bound: "i < length ts"
assumes ith: "ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)"
assumes subset: "𝒪 ⊆ 𝒪'"
shows "unowned_shared 𝒮 (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')])"
proof -
from i_bound ith subset
have "⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts) ⊆
⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')]))"
apply (auto simp add: in_set_conv_nth nth_list_update split: if_split_asm)
subgoal for x p'' is'' xs'' sb'' 𝒟'' 𝒪'' ℛ'' j
apply (case_tac "j=i")
apply (rule_tac x="(p',is',xs',sb',𝒟',𝒪',ℛ')" in bexI)
apply fastforce
apply (fastforce simp add: in_set_conv_nth)
apply (rule_tac x="(p'',is'',xs'',sb'',𝒟'',𝒪'',ℛ'')" in bexI)
apply fastforce
apply (fastforce simp add: in_set_conv_nth)
done
done
hence "- ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set (ts[i := (p',is',xs',sb',𝒟',𝒪',ℛ')])) ⊆
- ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)"
by blast
also note unowned_shared
finally
show ?thesis
by (unfold_locales)
qed
lemma (in unowned_shared) a_unowned_by_others_owned_or_shared:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_unowned_others:
"∀j<length (map owned ts). i ≠ j ⟶
(let 𝒪⇩j = (map owned ts)!j in a ∉ 𝒪⇩j)"
shows "a ∈ 𝒪 ∨ a ∈ dom 𝒮"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume a_unowned: "a ∉ 𝒪"
assume j_bound: "j < length ts"
assume jth: "ts!j = (p⇩j,is⇩j,xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j)"
have "a ∉ 𝒪⇩j"
proof (cases "i=j")
case True with a_unowned ts_i jth
show ?thesis
by auto
next
case False
from a_unowned_others [rule_format, of j] j_bound jth False
show ?thesis
by auto
qed
} note lem = this
{
assume "a ∉ 𝒪"
from lem [OF this]
have "a ∈ - ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)"
by (fastforce simp add: in_set_conv_nth)
with unowned_shared have "a ∈ dom 𝒮"
by auto
}
then
show ?thesis
by auto
qed
lemma (in unowned_shared) unowned_shared':
assumes notin: "∀i < length ts. a ∉ owned (ts!i)"
shows "a ∈ dom 𝒮"
proof -
from notin have "a ∈ - ⋃((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts)"
by (force simp add: in_set_conv_nth)
with unowned_shared show ?thesis by blast
qed
lemma unowned_shared_def': "unowned_shared 𝒮 ts = (∀a. (∀i < length ts. a ∉ owned (ts!i)) ⟶ a ∈ dom 𝒮)"
apply rule
apply clarsimp
apply (rule unowned_shared.unowned_shared')
apply fastforce
apply fastforce
apply (unfold unowned_shared_def)
apply clarsimp
subgoal for x
apply (drule_tac x=x in spec)
apply (erule impE)
apply clarsimp
apply (case_tac "(ts!i)")
apply (drule nth_mem)
apply auto
done
done
definition
"initial cfg ≡ let (ts,m,𝒮) = cfg
in unowned_shared 𝒮 ts ∧
(∀i < length ts. let (p,is,θ,x,𝒟,𝒪,ℛ) = ts!i in
ℛ = Map.empty )"
lemma initial_empty_rels: "initial (ts,m,𝒮) ⟹ ∀ℛ ∈ set (map released ts). ℛ = Map.empty"
by (fastforce simp add: initial_def simp add: in_set_conv_nth)
lemma initial_unowned_shared: "initial (ts,m,𝒮) ⟹ unowned_shared 𝒮 ts"
by (fastforce simp add: initial_def )
lemma initial_safe_free_flowing_implies_safe_delayed:
assumes init: "initial c"
assumes safe: "safe_free_flowing c"
shows "safe_delayed c"
proof -
obtain ts 𝒮 m where c: "c=(ts,m,𝒮)" by (cases c)
from initial_empty_rels [OF init [simplified c]]
have rels_empty: "∀ℛ∈set (map released ts). ℛ = Map.empty".
from initial_unowned_shared [OF init [simplified c]] have "unowned_shared 𝒮 ts"
by auto
hence us:"(∀a. (∀i < length (map owned ts). a ∉ (map owned ts!i)) ⟶ a ∈ dom 𝒮)"
by (simp add:unowned_shared_def')
{
fix i p "is" θ x 𝒟 𝒪 ℛ
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,x,𝒟,𝒪,ℛ)"
have "map owned ts,map released ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√"
proof -
from safeE [OF safe [simplified c] i_bound ts_i]
have "map owned ts,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√".
from memop_empty_rels_safe_free_flowing_implies_safe_delayed [OF this rels_empty _ us] i_bound ts_i
show ?thesis
by simp
qed
}
then show ?thesis
by (fastforce simp add: c safe_delayed_def)
qed
locale program_progress = program +
assumes progress: "θ⊢ p →⇩p (p',is') ⟹ p' ≠ p ∨ is' ≠ []"
text ‹The assumption `progress' could be avoided if we introduce stuttering steps in lemma ‹undo_local_step›
or make the scheduling of threads explicit, such that we can directly express that `thread i does not make a step'.
›
lemma (in program_progress) undo_local_step:
assumes step: "(ts,m,𝒮) ⇒⇩d (ts',m',𝒮')"
assumes i_bound: "i < length ts"
assumes unchanged: "ts!i = ts'!i"
assumes safe_delayed_undo: "safe_delayed (u_ts,u_m,u_shared)"
assumes leq: "length u_ts = length ts"
assumes others_same: "∀j < length ts. j≠i ⟶ u_ts!j = ts!j"
assumes u_ts_i: "u_ts!i=(u_p,u_is,u_tmps,u_x,u_dirty,u_owns,u_rels)"
assumes u_m_other: "∀a. a ∉ u_owns ⟶ u_m a = m a"
assumes u_m_shared: "∀a. a ∈ u_owns ⟶ a ∈ dom u_shared ⟶ u_m a = m a"
assumes u_shared: "∀a. a ∉ u_owns ⟶ a ∉ owned (ts!i) ⟶ u_shared a = 𝒮 a"
assumes dist: "simple_ownership_distinct u_ts"
assumes dist_ts: "simple_ownership_distinct ts"
shows "∃u_ts' u_shared' u_m'. (u_ts,u_m,u_shared) ⇒⇩d (u_ts',u_m',u_shared') ∧
u_ts'!i = u_ts!i ∧
(∀a ∈ u_owns. u_shared' a = u_shared a) ∧
(∀a ∈ u_owns. 𝒮' a = 𝒮 a) ∧
(∀a ∈ u_owns. u_m' a = u_m a) ∧
(∀a ∈ u_owns. m' a = m a) ∧
(∀j < length ts. j≠i ⟶ u_ts'!j = ts'!j) ∧
(∀a. a ∉ u_owns ⟶ a ∉ owned (ts!i) ⟶ u_shared' a = 𝒮' a) ∧
(∀a. a ∉ u_owns ⟶ u_m' a = m' a)"
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from dist interpret simple_ownership_distinct u_ts .
from step
show ?thesis
proof (cases)
case (Program j p "is" θ sb 𝒟 𝒪 ℛ p' is')
then obtain
ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')"
by auto
from progress [OF prog_step] i_bound unchanged ts_j ts'
have neq_j_i: "j≠i"
by auto
from others_same [rule_format, OF j_bound neq_j_i] ts_j
have u_ts_j: "u_ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
from leq j_bound have j_bound': "j < length u_ts"
by simp
from leq i_bound have i_bound': "i < length u_ts"
by simp
from direct_computation.Program [OF j_bound' u_ts_j prog_step]
have ustep:" (u_ts,u_m, u_shared) ⇒⇩d (u_ts[j := (p', is @ is', θ, sb, 𝒟, 𝒪, ℛ)], u_m, u_shared)". show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j
apply (auto simp add: nth_list_update ts' 𝒮' m')
done
next
case (Memop j p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
mem_step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', sb',m', 𝒟', 𝒪', ℛ', 𝒮')"
by auto
from mem_step i_bound unchanged ts_j
have neq_j_i: "j≠i"
by cases (auto simp add: ts')
from others_same [rule_format, OF j_bound neq_j_i] ts_j
have u_ts_j: "u_ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
from leq j_bound have j_bound': "j < length u_ts"
by simp
from leq i_bound have i_bound': "i < length u_ts"
by simp
from safe_delayedE [OF safe_delayed_undo j_bound' u_ts_j]
have safe_j: "map owned u_ts,map released u_ts,j⊢(is, θ, u_m, 𝒟, 𝒪, u_shared)√".
from simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i]
have owns_u_owns: "𝒪 ∩ u_owns = {}" .
from mem_step
show ?thesis
proof (cases)
case (Read volatile a t)
then obtain
"is": "is = Read volatile a t # is'" and
θ': "θ' = θ(t ↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
access_cond: "a ∈ 𝒪 ∨ a ∈ read_only u_shared ∨
(volatile ∧ a ∈ dom u_shared)"
and
clean: "volatile ⟶ ¬ 𝒟"
by cases auto
have u_m_a_eq: "u_m a = m a"
proof (cases "a ∈ u_owns")
case True
with simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i]
have "a ∉ 𝒪" by auto
with access_cond read_only_dom [of u_shared] have "a ∈ dom u_shared"
by auto
from u_m_shared [rule_format, OF True this]
show ?thesis .
next
case False
from u_m_other [rule_format, OF this]
show ?thesis .
qed
note Read' = direct_memop_step.Read [of volatile a t "is'" θ sb u_m 𝒟 𝒪 ℛ u_shared]
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Read' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d (u_ts[j := (p, is', θ(t ↦ u_m a), sb, 𝒟, 𝒪, ℛ)], u_m, u_shared)".
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j
by (auto simp add: nth_list_update ts' eqs' u_m_a_eq)
next
case (WriteNonVolatile a D f A L R W)
then obtain
"is": "is = Write False a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
owned: "a ∈ 𝒪" and unshared: "a ∉ dom u_shared"
by cases auto
from simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i] owned
have a_unowned_i: "a ∉ u_owns"
by auto
note Write' = direct_memop_step.WriteNonVolatile [of a D f A L R W is' θ sb u_m 𝒟 𝒪 ℛ u_shared]
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d (u_ts[j := (p, is', θ, sb, 𝒟, 𝒪, ℛ)], u_m (a := f θ), u_shared)".
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j a_unowned_i
apply (auto simp add: nth_list_update ts' eqs')
done
next
case (WriteVolatile a D f A L R W)
then obtain
"is": "is = Write True a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=True" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
a_unowned_others: "∀k < length u_ts. j≠k ⟶ a ∉ (map owned u_ts!k ∪ dom (map released u_ts!k))" and
A: "A ⊆ dom u_shared ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length u_ts. j≠k ⟶ A ∩ (map owned u_ts!k ∪ dom (map released u_ts!k)) = {}" and
a_not_ro: "a ∉ read_only u_shared"
by cases auto
note Write' = direct_memop_step.WriteVolatile [of a D f A L R W is' θ sb u_m 𝒟 𝒪 ℛ u_shared]
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d
(u_ts[j := (p, is', θ, sb, True, 𝒪 ∪ A - R, Map.empty)], u_m (a := f θ), u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound'
have A_u_owns: "A ∩ u_owns = {}" by auto
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = u_shared a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_owned_shared = this
from a_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound' have a_u_owns: "a ∉ u_owns" by auto
{
fix a
assume a_u_owns: "a ∉ u_owns"
assume a_u_owns_orig: "a ∉ owned (ts!i)"
from u_shared [rule_format, OF a_u_owns a_u_owns_orig]
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
using R_owns A_R L_A A_u_owns owns_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_unowned_shared = this
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note 𝒮'_shared = this
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared a_u_owns u_unowned_shared 𝒮'_shared
apply (auto simp add: nth_list_update ts' eqs')
done
next
case Fence
then obtain
"is": "is = Fence # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
note Fence' = direct_memop_step.Fence [of is' θ sb u_m 𝒟 𝒪 ℛ u_shared]
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Fence' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d (u_ts[j := (p, is', θ, sb, False, 𝒪, Map.empty)], u_m, u_shared)".
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j
by (auto simp add: nth_list_update ts' eqs' )
next
case (RMWReadOnly cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮" and
cond: "¬ cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"] owns_u_owns u_ts_i i_bound' neq_j_i
obtain
access_cond: "a ∉ u_owns ∨ (a ∈ dom u_shared ∧ a ∈ u_owns)"
by cases auto
from u_m_other u_m_shared access_cond
have u_m_a_eq: "u_m a = m a"
by auto
from cond u_m_a_eq have cond': "¬ cond (θ(t ↦ u_m a))"
by auto
note RMWReadOnly' = direct_memop_step.RMWReadOnly [of cond θ t u_m a D f ret A L R W is' sb 𝒟 𝒪 ℛ u_shared,
OF cond']
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF RMWReadOnly' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d (u_ts[j := (p, is', θ(t ↦ u_m a), sb, False, 𝒪, Map.empty)], u_m, u_shared)".
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j
by (auto simp add: nth_list_update ts' eqs' u_m_a_eq)
next
case (RMWWrite cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t ↦ ret (m a) (f (θ(t ↦ m a))))" and
sb': "sb'=sb" and
m': "m'=m(a := f (θ(t ↦ m a)))" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L" and
cond: "cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"] owns_u_owns u_ts_i i_bound' neq_j_i
obtain
access_cond: "a ∉ u_owns ∨ (a ∈ dom u_shared ∧ a ∈ u_owns)"
by cases auto
from u_m_other u_m_shared access_cond
have u_m_a_eq: "u_m a = m a"
by auto
from cond u_m_a_eq have cond': "cond (θ(t ↦ u_m a))"
by auto
from safe_j [simplified "is"] cond'
obtain
a_unowned_others: "∀k < length u_ts. j≠k ⟶ a ∉ (map owned u_ts!k ∪ dom (map released u_ts!k))" and
A: "A ⊆ dom u_shared ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length u_ts. j≠k ⟶ A ∩ (map owned u_ts!k ∪ dom (map released u_ts!k)) = {}" and
a_not_ro: "a ∉ read_only u_shared"
by cases auto
note Write' = direct_memop_step.RMWWrite [of cond θ t u_m a D f ret A L R W is' sb 𝒟 𝒪 ℛ u_shared,
OF cond']
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Write' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d
(u_ts[j := (p, is', θ(t ↦ ret (u_m a) (f (θ(t ↦ u_m a)))), sb, False, 𝒪 ∪ A - R, Map.empty)], u_m(a := f (θ(t ↦ u_m a))),
u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound'
have A_u_owns: "A ∩ u_owns = {}" by auto
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = u_shared a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_owned_shared = this
from a_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound' have a_u_owns: "a ∉ u_owns" by auto
{
fix a
assume a_u_owns: "a ∉ u_owns"
assume a_u_owns_orig: "a ∉ owned (ts!i)"
from u_shared [rule_format, OF a_u_owns this]
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
using R_owns A_R L_A A_u_owns owns_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_unowned_shared = this
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note 𝒮'_shared = this
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared a_u_owns u_unowned_shared 𝒮'_shared
apply (auto simp add: nth_list_update ts' eqs')
done
next
case (Ghost A L R W)
then obtain
"is": "is = Ghost A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=augment_rels (dom 𝒮) R ℛ" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
A: "A ⊆ dom u_shared ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length u_ts. j≠k ⟶ A ∩ (map owned u_ts!k ∪ dom (map released u_ts!k)) = {}"
by cases auto
note Ghost' = direct_memop_step.Ghost [of A L R W is' θ sb u_m 𝒟 𝒪 ℛ u_shared]
from direct_computation.Memop [OF j_bound' u_ts_j, simplified "is", OF Ghost' ]
have ustep: "(u_ts, u_m, u_shared) ⇒⇩d
(u_ts[j := (p, is', θ, sb, 𝒟, 𝒪 ∪ A - R, augment_rels (dom u_shared) R ℛ )], u_m,
u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from A_unowned_others [rule_format, OF i_bound' neq_j_i] u_ts_i i_bound'
have A_u_owns: "A ∩ u_owns = {}" by auto
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = u_shared a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_owned_shared = this
{
fix a
assume a_u_owns: "a ∉ u_owns"
assume "a ∉ owned (ts!i)"
from u_shared [rule_format, OF a_u_owns this]
have "(u_shared ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
using R_owns A_R L_A A_u_owns owns_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note u_unowned_shared = this
{
fix a
assume a_u_owns: "a ∈ u_owns"
have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
using R_owns A_R L_A A_u_owns owns_u_owns a_u_owns
by (auto simp add: restrict_shared_def augment_shared_def split: option.splits)
}
note 𝒮'_shared = this
from dist_ts
interpret dist_ts_inter: simple_ownership_distinct ts .
from dist_ts_inter.simple_ownership_distinct [OF j_bound i_bound neq_j_i ts_j]
have "𝒪 ∩ owned (ts!i) = {}"
apply (cases "ts!i")
apply fastforce+
done
with simple_ownership_distinct [OF j_bound' i_bound' neq_j_i u_ts_j u_ts_i] R_owns u_shared
have augment_eq: "augment_rels (dom u_shared) R ℛ = augment_rels (dom 𝒮) R ℛ"
apply -
apply (rule ext)
apply (fastforce simp add: augment_rels_def split: option.splits simp add: domIff)
done
show ?thesis
apply -
apply (rule exI)
apply (rule exI)
apply (rule exI)
apply (rule conjI)
apply (rule ustep)
using neq_j_i others_same u_m_other u_shared j_bound leq ts_j u_owned_shared u_unowned_shared 𝒮'_shared
apply (auto simp add: nth_list_update ts' eqs' augment_eq)
done
qed
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
theorem (in program) safe_step_preserves_simple_ownership_distinct:
assumes step: "(ts,m,𝒮) ⇒⇩d (ts',m',𝒮')"
assumes safe: "safe_delayed (ts,m,𝒮)"
assumes dist: "simple_ownership_distinct ts"
shows "simple_ownership_distinct ts'"
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from dist interpret simple_ownership_distinct ts .
from step
show ?thesis
proof (cases)
case (Program j p "is" θ sb 𝒟 𝒪 ℛ p' is')
then obtain
ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')"
by auto
from simple_ownership_distinct [OF j_bound _ _ ts_j]
show "simple_ownership_distinct ts'"
apply (simp only: ts')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (Memop j p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
mem_step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', sb',m', 𝒟', 𝒪', ℛ', 𝒮')"
by auto
from safe_delayedE [OF safe j_bound ts_j]
have safe_j: "map owned ts,map released ts,j⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√".
from mem_step
show ?thesis
proof (cases)
case (Read volatile a t)
then obtain
"is": "is = Read volatile a t # is'" and
θ': "θ' = θ(t ↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from simple_ownership_distinct [OF j_bound _ _ ts_j]
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (WriteNonVolatile a D f A L R W)
then obtain
"is": "is = Write False a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from simple_ownership_distinct [OF j_bound _ _ ts_j]
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (WriteVolatile a D f A L R W)
then obtain
"is": "is = Write True a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=True" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case Fence
then obtain
"is": "is = Fence # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from simple_ownership_distinct [OF j_bound _ _ ts_j]
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (RMWReadOnly cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮" and
cond: "¬ cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from simple_ownership_distinct [OF j_bound _ _ ts_j]
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (RMWWrite cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t ↦ ret (m a) (f (θ(t ↦ m a))))" and
sb': "sb'=sb" and
m': "m'=m(a := f (θ(t ↦ m a)))" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L" and
cond: "cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"] cond
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
next
case (Ghost A L R W)
then obtain
"is": "is = Ghost A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=augment_rels (dom 𝒮) R ℛ" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}"
by cases auto
from simple_ownership_distinct [OF j_bound _ _ ts_j] R_owns A_R A_unowned_others
show "simple_ownership_distinct ts'"
apply (simp only: ts' eqs')
apply (rule simple_ownership_distinct_nth_update [OF j_bound ts_j])
apply force
done
qed
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
theorem (in program) safe_step_preserves_read_only_unowned:
assumes step: "(ts,m,𝒮) ⇒⇩d (ts',m',𝒮')"
assumes safe: "safe_delayed (ts,m,𝒮)"
assumes dist: "simple_ownership_distinct ts"
assumes ro_unowned: "read_only_unowned 𝒮 ts"
shows "read_only_unowned 𝒮' ts'"
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from dist interpret simple_ownership_distinct ts .
from ro_unowned interpret read_only_unowned 𝒮 ts .
from step
show ?thesis
proof (cases)
case (Program j p "is" θ sb 𝒟 𝒪 ℛ p' is')
then obtain
ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')"
by auto
from read_only_unowned [OF j_bound ts_j]
show "read_only_unowned 𝒮' ts'"
apply (simp only: ts' 𝒮')
apply (rule read_only_unowned_nth_update [OF j_bound])
apply force
done
next
case (Memop j p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
mem_step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', sb',m', 𝒟', 𝒪', ℛ', 𝒮')"
by auto
from safe_delayedE [OF safe j_bound ts_j]
have safe_j: "map owned ts,map released ts,j⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√".
from mem_step
show ?thesis
proof (cases)
case (Read volatile a t)
then obtain
"is": "is = Read volatile a t # is'" and
θ': "θ' = θ(t ↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from read_only_unowned [OF j_bound ts_j]
show "read_only_unowned 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule read_only_unowned_nth_update [OF j_bound])
apply force
done
next
case (WriteNonVolatile a D f A L R W)
then obtain
"is": "is = Write False a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from read_only_unowned [OF j_bound ts_j]
show "read_only_unowned 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule read_only_unowned_nth_update [OF j_bound])
apply force
done
next
case (WriteVolatile a D f A L R W)
then obtain
"is": "is = Write True a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=True" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
show "read_only_unowned 𝒮' ts'"
proof (unfold_locales)
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts'"
assume ts'_i: "ts'!i = (p⇩i,is⇩i,θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i,ℛ⇩i)"
show "𝒪⇩i ∩ read_only 𝒮' = {}"
proof (cases "i=j")
case True
with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound
show ?thesis
by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
next
case False
from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
have "𝒪 ∩ 𝒪⇩i = {}"
by (fastforce simp add: ts')
with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i]
read_only_unowned [of i p⇩i is⇩i θ⇩i sb⇩i 𝒟⇩i 𝒪⇩i ℛ⇩i]
False i_bound ts'_i False
show ?thesis
by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
qed
qed
next
case Fence
then obtain
"is": "is = Fence # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from read_only_unowned [OF j_bound ts_j]
show "read_only_unowned 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule read_only_unowned_nth_update [OF j_bound])
apply force
done
next
case (RMWReadOnly cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮" and
cond: "¬ cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from read_only_unowned [OF j_bound ts_j]
show "read_only_unowned 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule read_only_unowned_nth_update [OF j_bound])
apply force
done
next
case (RMWWrite cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t ↦ ret (m a) (f (θ(t ↦ m a))))" and
sb': "sb'=sb" and
m': "m'=m(a := f (θ(t ↦ m a)))" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L" and
cond: "cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"] cond
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
show "read_only_unowned 𝒮' ts'"
proof (unfold_locales)
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts'"
assume ts'_i: "ts'!i = (p⇩i,is⇩i,θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i,ℛ⇩i)"
show "𝒪⇩i ∩ read_only 𝒮' = {}"
proof (cases "i=j")
case True
with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound
show ?thesis
by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
next
case False
from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
have "𝒪 ∩ 𝒪⇩i = {}"
by (fastforce simp add: ts')
with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i]
read_only_unowned [of i p⇩i is⇩i θ⇩i sb⇩i 𝒟⇩i 𝒪⇩i ℛ⇩i]
False i_bound ts'_i False
show ?thesis
by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
qed
qed
next
case (Ghost A L R W)
then obtain
"is": "is = Ghost A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=augment_rels (dom 𝒮) R ℛ" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}"
by cases auto
show "read_only_unowned 𝒮' ts'"
proof (unfold_locales)
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts'"
assume ts'_i: "ts'!i = (p⇩i,is⇩i,θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i,ℛ⇩i)"
show "𝒪⇩i ∩ read_only 𝒮' = {}"
proof (cases "i=j")
case True
with read_only_unowned [OF j_bound ts_j] ts'_i A L_A R_owns A_R j_bound
show ?thesis
by (auto simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
next
case False
from simple_ownership_distinct [OF j_bound _ False [symmetric] ts_j] ts'_i i_bound j_bound False
have "𝒪 ∩ 𝒪⇩i = {}"
by (fastforce simp add: ts')
with A L_A R_owns A_R j_bound A_unowned_others [rule_format, of i]
read_only_unowned [of i p⇩i is⇩i θ⇩i sb⇩i 𝒟⇩i 𝒪⇩i ℛ⇩i]
False i_bound ts'_i False
show ?thesis
by (force simp add: eqs' ts' read_only_def augment_shared_def restrict_shared_def domIff split: option.splits)
qed
qed
qed
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
theorem (in program) safe_step_preserves_unowned_shared:
assumes step: "(ts,m,𝒮) ⇒⇩d (ts',m',𝒮')"
assumes safe: "safe_delayed (ts,m,𝒮)"
assumes dist: "simple_ownership_distinct ts"
assumes unowned_shared: "unowned_shared 𝒮 ts"
shows "unowned_shared 𝒮' ts'"
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from dist interpret simple_ownership_distinct ts .
from unowned_shared interpret unowned_shared 𝒮 ts .
from step
show ?thesis
proof (cases)
case (Program j p "is" θ sb 𝒟 𝒪 ℛ p' is')
then obtain
ts': "ts' = ts[j:=(p',is@is',θ,sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')"
by auto
show "unowned_shared 𝒮' ts'"
apply (simp only: ts' 𝒮')
apply (rule unowned_shared_nth_update [OF j_bound ts_j] )
apply force
done
next
case (Memop j p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[j:=(p,is',θ',sb',𝒟',𝒪',ℛ')]" and
j_bound: "j < length ts" and
ts_j: "ts!j = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
mem_step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) → (is', θ', sb',m', 𝒟', 𝒪', ℛ', 𝒮')"
by auto
from safe_delayedE [OF safe j_bound ts_j]
have safe_j: "map owned ts,map released ts,j⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√".
from mem_step
show ?thesis
proof (cases)
case (Read volatile a t)
then obtain
"is": "is = Read volatile a t # is'" and
θ': "θ' = θ(t ↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
show "unowned_shared 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule unowned_shared_nth_update [OF j_bound ts_j])
apply force
done
next
case (WriteNonVolatile a D f A L R W)
then obtain
"is": "is = Write False a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
show "unowned_shared 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule unowned_shared_nth_update [OF j_bound ts_j])
apply force
done
next
case (WriteVolatile a D f A L R W)
then obtain
"is": "is = Write True a (D, f) A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m(a:=f θ)" and
𝒟': "𝒟'=True" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
show "unowned_shared 𝒮' ts'"
apply (clarsimp simp add: unowned_shared_def')
using A R_owns L_A A_R A_unowned_others ts_j j_bound
apply (auto simp add: 𝒮' ts' 𝒪')
apply (rule unowned_shared')
apply clarsimp
apply (drule_tac x=i in spec)
apply (case_tac "i=j")
apply clarsimp
apply clarsimp
apply (drule_tac x=j in spec)
apply auto
done
next
case Fence
then obtain
"is": "is = Fence # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
show "unowned_shared 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule unowned_shared_nth_update [OF j_bound ts_j])
apply force
done
next
case (RMWReadOnly cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t↦ m a)" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮" and
cond: "¬ cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
show "unowned_shared 𝒮' ts'"
apply (simp only: ts' eqs')
apply (rule unowned_shared_nth_update [OF j_bound ts_j])
apply force
done
next
case (RMWWrite cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W # is'" and
θ': "θ' = θ(t ↦ ret (m a) (f (θ(t ↦ m a))))" and
sb': "sb'=sb" and
m': "m'=m(a := f (θ(t ↦ m a)))" and
𝒟': "𝒟'=False" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=Map.empty" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L" and
cond: "cond (θ(t ↦ m a))"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"] cond
obtain
a_unowned_others: "∀k < length ts. j≠k ⟶ a ∉ (map owned ts!k ∪ dom (map released ts!k))" and
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}" and
a_not_ro: "a ∉ read_only 𝒮"
by cases auto
show "unowned_shared 𝒮' ts'"
apply (clarsimp simp add: unowned_shared_def')
using A R_owns L_A A_R A_unowned_others ts_j j_bound
apply (auto simp add: 𝒮' ts' 𝒪')
apply (rule unowned_shared')
apply clarsimp
apply (drule_tac x=i in spec)
apply (case_tac "i=j")
apply clarsimp
apply clarsimp
apply (drule_tac x=j in spec)
apply auto
done
next
case (Ghost A L R W)
then obtain
"is": "is = Ghost A L R W # is'" and
θ': "θ' = θ" and
sb': "sb'=sb" and
m': "m'=m" and
𝒟': "𝒟'=𝒟" and
𝒪': "𝒪'=𝒪 ∪ A - R" and
ℛ': "ℛ'=augment_rels (dom 𝒮) R ℛ" and
𝒮': "𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
note eqs' = θ' sb' m' 𝒟' 𝒪' ℛ' 𝒮'
from safe_j [simplified "is"]
obtain
A: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪" and A_R: "A ∩ R = {}" and
A_unowned_others: "∀k < length ts. j≠k ⟶ A ∩ (map owned ts!k ∪ dom (map released ts!k)) = {}"
by cases auto
show "unowned_shared 𝒮' ts'"
apply (clarsimp simp add: unowned_shared_def')
using A R_owns L_A A_R A_unowned_others ts_j j_bound
apply (auto simp add: 𝒮' ts' 𝒪')
apply (rule unowned_shared')
apply clarsimp
apply (drule_tac x=i in spec)
apply (case_tac "i=j")
apply clarsimp
apply clarsimp
apply (drule_tac x=j in spec)
apply auto
done
qed
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
locale program_trace = program +
fixes c
fixes n::nat
fixes k::nat
assumes step: "⋀l. l < k ⟹ c (n+l) ⇒⇩d c (n + (Suc l))"
abbreviation (in program)
"trace ≡ program_trace program_step"
lemma (in program) trace_0 [simp]: "trace c n 0"
apply (unfold_locales)
apply auto
done
lemma split_less_Suc: "(∀x<Suc k. P x) = (P k ∧ (∀x<k. P x))"
apply rule
apply clarsimp
apply clarsimp
apply (case_tac "x = k")
apply auto
done
lemma split_le_Suc: "(∀x≤Suc k. P x) = (P (Suc k) ∧ (∀x≤k. P x))"
apply rule
apply clarsimp
apply clarsimp
apply (case_tac "x = Suc k")
apply auto
done
lemma (in program) steps_to_trace:
assumes steps: "x ⇒⇩d⇧* y"
shows "∃c k. trace c 0 k ∧ c 0 = x ∧ c k = y"
using steps
proof (induct)
case base
thus ?case
apply (rule_tac x="λk. x" in exI)
apply (rule_tac x=0 in exI)
by (auto simp add: program_trace_def)
next
case (step y z)
have first: "x ⇒⇩d⇧* y" by fact
have last: "y ⇒⇩d z" by fact
from step.hyps obtain c k where
trace: "trace c 0 k" and c_0: "c 0 = x" and c_k: "c k = y"
by auto
define c' where "c' == λi. (if i ≤ k then c i else z)"
from trace last c_k have "trace c' 0 (k + 1)"
apply (clarsimp simp add: c'_def program_trace_def)
apply (subgoal_tac "l=k")
apply (simp)
apply (simp)
done
with c_0
show ?case
apply -
apply (rule_tac x="c'" in exI)
apply (rule_tac x="k + 1" in exI)
apply (auto simp add: c'_def)
done
qed
lemma (in program) trace_preserves_length_ts:
"⋀l x. trace c n k ⟹ l ≤ k ⟹ x ≤ k ⟹ length (fst (c (n + l))) = length (fst (c (n + x)))"
proof (induct k)
case 0
thus ?case by auto
next
case (Suc k)
then obtain trace_suc: "trace c n (Suc k)" and
l_suc: "l ≤ Suc k" and
x_suc: "x ≤ Suc k"
by simp
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from trace_suc obtain
trace_k: "trace c n k" and
last_step: "c (n + k) ⇒⇩d c (n + (Suc k)) "
by (clarsimp simp add: program_trace_def)
obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)")
obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))")
from direct_computation.step_preserves_length_ts [OF last_step [simplified c_k c_suc_k]] c_k c_suc_k
have leq: "length (fst (c (n + Suc k))) = length (fst (c (n + k)))"
by simp
show ?case
proof (cases "l = Suc k")
case True
note l_suc = this
show ?thesis
proof (cases "x = Suc k")
case True with l_suc show ?thesis by simp
next
case False
with x_suc have "x ≤ k" by simp
from Suc.hyps [OF trace_k this, of k]
have "length (fst (c (n + x))) = length (fst (c (n + k)))"
by simp
with leq show ?thesis using l_suc by simp
qed
next
case False
with l_suc have l_k: "l ≤ k"
by auto
show ?thesis
proof (cases "x = Suc k")
case True
from Suc.hyps [OF trace_k l_k, of k]
have "length (fst (c (n + l))) = length (fst (c (n + k)))" by simp
with leq True show ?thesis by simp
next
case False
with x_suc have "x ≤ k" by simp
from Suc.hyps [OF trace_k l_k this]
show ?thesis by simp
qed
qed
qed
lemma (in program) trace_preserves_simple_ownership_distinct:
assumes dist: "simple_ownership_distinct (fst (c n))"
shows "⋀l. trace c n k ⟹ (∀x < k. safe_delayed (c (n + x))) ⟹
l ≤ k ⟹ simple_ownership_distinct (fst (c (n + l)))"
proof (induct k)
case 0 thus ?case using dist by auto
next
case (Suc k)
then obtain
trace_suc: "trace c n (Suc k)" and
safe_suc: "∀x<Suc k. safe_delayed (c (n + x))" and
l_suc: "l ≤ Suc k"
by simp
from trace_suc obtain
trace_k: "trace c n k" and
last_step: "c (n + k) ⇒⇩d c (n + (Suc k)) "
by (clarsimp simp add: program_trace_def)
obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)")
obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))")
from safe_suc c_suc_k c_k
obtain
safe_up_k: "∀x<k. safe_delayed (c (n + x))" and
safe_k: "safe_delayed (ts,m,𝒮)"
by (auto simp add: split_le_Suc)
from Suc.hyps [OF trace_k safe_up_k]
have hyp: "∀l ≤ k. simple_ownership_distinct (fst (c (n + l)))"
by simp
from Suc.hyps [OF trace_k safe_up_k, of k] c_k
have "simple_ownership_distinct ts"
by simp
from safe_step_preserves_simple_ownership_distinct [OF last_step[simplified c_k c_suc_k] safe_k this]
have "simple_ownership_distinct ts'".
then show ?case
using c_suc_k hyp l_suc
apply (cases "l=Suc k")
apply (auto simp add: split_less_Suc)
done
qed
lemma (in program) trace_preserves_read_only_unowned:
assumes dist: "simple_ownership_distinct (fst (c n))"
assumes ro: "read_only_unowned (snd (snd (c n))) (fst (c n))"
shows "⋀l. trace c n k ⟹ (∀x < k. safe_delayed (c (n + x))) ⟹
l ≤ k ⟹ read_only_unowned (snd (snd (c (n + l)))) (fst (c (n + l)))"
proof (induct k)
case 0 thus ?case using ro by auto
next
case (Suc k)
then obtain
trace_suc: "trace c n (Suc k)" and
safe_suc: "∀x<Suc k. safe_delayed (c (n + x))" and
l_suc: "l ≤ Suc k"
by simp
from trace_suc obtain
trace_k: "trace c n k" and
last_step: "c (n + k) ⇒⇩d c (n + (Suc k)) "
by (clarsimp simp add: program_trace_def)
obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)")
obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))")
from safe_suc c_suc_k c_k
obtain
safe_up_k: "∀x<k. safe_delayed (c (n + x))" and
safe_k: "safe_delayed (ts,m,𝒮)"
by (auto simp add: split_le_Suc)
from Suc.hyps [OF trace_k safe_up_k]
have hyp: "∀l ≤ k. read_only_unowned (snd (snd (c (n + l)))) (fst (c (n + l)))"
by simp
from Suc.hyps [OF trace_k safe_up_k, of k] c_k
have ro': "read_only_unowned 𝒮 ts"
by simp
from trace_preserves_simple_ownership_distinct [where c=c and n=n, OF dist trace_k safe_up_k, of k] c_k
have dist': "simple_ownership_distinct ts" by simp
from safe_step_preserves_read_only_unowned [OF last_step[simplified c_k c_suc_k] safe_k dist' ro']
have "read_only_unowned 𝒮' ts'".
then show ?case
using c_suc_k hyp l_suc
apply (cases "l=Suc k")
apply (auto simp add: split_less_Suc)
done
qed
lemma (in program) trace_preserves_unowned_shared:
assumes dist: "simple_ownership_distinct (fst (c n))"
assumes ro: "unowned_shared (snd (snd (c n))) (fst (c n))"
shows "⋀l. trace c n k ⟹ (∀x < k. safe_delayed (c (n + x))) ⟹
l ≤ k ⟹ unowned_shared (snd (snd (c (n + l)))) (fst (c (n + l)))"
proof (induct k)
case 0 thus ?case using ro by auto
next
case (Suc k)
then obtain
trace_suc: "trace c n (Suc k)" and
safe_suc: "∀x<Suc k. safe_delayed (c (n + x))" and
l_suc: "l ≤ Suc k"
by simp
from trace_suc obtain
trace_k: "trace c n k" and
last_step: "c (n + k) ⇒⇩d c (n + (Suc k)) "
by (clarsimp simp add: program_trace_def)
obtain ts 𝒮 m where c_k: "c (n + k) = (ts, m, 𝒮)" by (cases "c (n + k)")
obtain ts' 𝒮' m' where c_suc_k: "c (n + (Suc k)) = (ts', m', 𝒮')" by (cases "c (n + (Suc k))")
from safe_suc c_suc_k c_k
obtain
safe_up_k: "∀x<k. safe_delayed (c (n + x))" and
safe_k: "safe_delayed (ts,m,𝒮)"
by (auto simp add: split_le_Suc)
from Suc.hyps [OF trace_k safe_up_k]
have hyp: "∀l ≤ k. unowned_shared (snd (snd (c (n + l)))) (fst (c (n + l)))"
by simp
from Suc.hyps [OF trace_k safe_up_k, of k] c_k
have ro': "unowned_shared 𝒮 ts"
by simp
from trace_preserves_simple_ownership_distinct [where c=c and n=n, OF dist trace_k safe_up_k, of k] c_k
have dist': "simple_ownership_distinct ts" by simp
from safe_step_preserves_unowned_shared [OF last_step[simplified c_k c_suc_k] safe_k dist' ro']
have "unowned_shared 𝒮' ts'".
then show ?case
using c_suc_k hyp l_suc
apply (cases "l=Suc k")
apply (auto simp add: split_less_Suc)
done
qed
theorem (in program_progress) undo_local_steps:
assumes steps: "trace c n k"
assumes c_n: "c n = (ts,m,𝒮)"
assumes unchanged: "∀l ≤ k. (∀ts⇩l 𝒮⇩l m⇩l . c (n + l) = (ts⇩l,m⇩l,𝒮⇩l) ⟶ ts⇩l!i=ts!i)"
assumes safe: "safe_delayed (u_ts, u_m, u_shared)"
assumes leq: "length u_ts = length ts"
assumes i_bound: "i < length ts"
assumes others_same: "∀j < length ts. j≠i ⟶ u_ts!j = ts!j"
assumes u_ts_i: "u_ts!i=(u_p,u_is,u_tmps,u_sb,u_dirty,u_owns,u_rels)"
assumes u_m_other: "∀a. a ∉ u_owns ⟶ u_m a = m a"
assumes u_m_shared: "∀a. a ∈ u_owns ⟶ a ∈ dom u_shared ⟶ u_m a = m a"
assumes u_shared: "∀a. a ∉ u_owns ⟶ a ∉ owned (ts!i) ⟶ u_shared a = 𝒮 a"
assumes dist: "simple_ownership_distinct u_ts"
assumes dist_ts: "simple_ownership_distinct ts"
assumes safe_orig: "∀x. x < k ⟶ safe_delayed (c (n + x))"
shows "∃c' l. l ≤ k ∧ trace c' n l ∧
c' n = (u_ts, u_m, u_shared) ∧
(∀x ≤ l. length (fst (c' (n + x))) = length (fst (c (n + x)))) ∧
(∀x < l. safe_delayed (c' (n + x))) ∧
(l < k ⟶ ¬ safe_delayed (c' (n + l))) ∧
(∀x ≤ l. ∀ts⇩x 𝒮⇩x m⇩x ts⇩x' 𝒮⇩x' m⇩x' . c (n + x) = (ts⇩x,m⇩x,𝒮⇩x) ⟶ c' (n+ x) = (ts⇩x',m⇩x',𝒮⇩x') ⟶
ts⇩x'!i=u_ts!i ∧
(∀a ∈ u_owns. 𝒮⇩x' a = u_shared a) ∧
(∀a ∈ u_owns. 𝒮⇩x a = 𝒮 a) ∧
(∀a ∈ u_owns. m⇩x' a = u_m a) ∧
(∀a ∈ u_owns. m⇩x a = m a)) ∧
(∀x ≤ l. ∀ts⇩x 𝒮⇩x m⇩x ts⇩x' 𝒮⇩x' m⇩x'. c (n + x) = (ts⇩x,m⇩x,𝒮⇩x) ⟶ c' (n + x) = (ts⇩x',m⇩x',𝒮⇩x') ⟶
(∀j < length ts⇩x. j≠i ⟶ ts⇩x'!j = ts⇩x!j) ∧
(∀a. a ∉ u_owns ⟶ a ∉ owned (ts!i) ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ u_owns ⟶ m⇩x' a = m⇩x a))
"
using steps unchanged safe_orig
proof (induct k)
case 0
show ?case
apply (rule_tac x="λ l. (u_ts, u_m, u_shared)" in exI)
apply (rule_tac x=0 in exI)
thm c_n
apply (simp add: c_n)
apply (clarsimp simp add: 0 leq others_same u_m_other u_shared)
done
next
case (Suc k)
then obtain
trace_suc: "trace c n (Suc k)" and
unchanged_suc: "∀l≤Suc k. ∀ts⇩l 𝒮⇩l m⇩l. c (n + l) = (ts⇩l, m⇩l, 𝒮⇩l) ⟶ ts⇩l ! i = ts ! i" and
safe_orig: "∀x<k. safe_delayed (c (n + x))"
by simp
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
from trace_suc obtain
trace_k: "trace c n k" and
last_step: "c (n + k) ⇒⇩d c (n + (Suc k)) "
by (clarsimp simp add: program_trace_def)
from unchanged_suc obtain
unchanged_k: "∀l≤k. ∀ts⇩l 𝒮⇩l m⇩l. c (n + l) = (ts⇩l, m⇩l, 𝒮⇩l) ⟶ ts⇩l ! i = ts ! i" and
unchanged_suc_k: "∀ts⇩l 𝒮⇩l m⇩l. c (n + (Suc k)) = (ts⇩l, m⇩l, 𝒮⇩l) ⟶ ts⇩l ! i = ts ! i"
apply -
apply (rule that)
apply auto
apply (drule_tac x=l in spec)
apply simp
done
from Suc.hyps [OF trace_k unchanged_k safe_orig] obtain c' l where
l_k: "l ≤ k" and
trace_c'_l: "trace c' n l" and
safe_l: "(∀x<l. safe_delayed (c' (n + x)))" and
unsafe_l: "(l < k ⟶ ¬ safe_delayed (c' (n + l)))" and
c'_n: "c' n = (u_ts, u_m, u_shared)" and
leq_l: "(∀x≤l. length (fst (c' (n + x))) = length (fst (c (n + x))))" and
unchanged_i: "(∀x≤l. ∀ts⇩x 𝒮⇩x m⇩x ts⇩x' 𝒮⇩x' m⇩x'.
c (n + x) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
c' (n + x) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
ts⇩x' ! i = u_ts ! i ∧
(∀a∈u_owns. 𝒮⇩x' a = u_shared a) ∧
(∀a∈u_owns. 𝒮⇩x a = 𝒮 a) ∧
(∀a∈u_owns. m⇩x' a = u_m a) ∧
(∀a∈u_owns. m⇩x a = m a))" and
sim: "(∀x≤l. ∀ts⇩x 𝒮⇩x m⇩x ts⇩x' 𝒮⇩x' m⇩x'.
c (n + x) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
c' (n + x) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
(∀j<length ts⇩x. j ≠ i ⟶ ts⇩x' ! j = ts⇩x ! j) ∧
(∀a. a ∉ u_owns ⟶ a ∉ owned (ts!i) ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ u_owns ⟶ m⇩x' a = m⇩x a))"
by auto
show ?case
proof (cases "l < k")
case True
with True trace_c'_l safe_l unsafe_l unchanged_i sim leq_l c'_n
show ?thesis
apply -
apply (rule_tac x="c'" in exI)
apply (rule_tac x="l" in exI)
apply auto
done
next
case False
with l_k have l_k: "l=k" by auto
show ?thesis
proof (cases "safe_delayed (c' (n + k))")
case False
with False l_k trace_c'_l safe_l unsafe_l unchanged_i sim leq_l c'_n
show ?thesis
apply -
apply (rule_tac x="c'" in exI)
apply (rule_tac x="k" in exI)
apply auto
done
next
case True
note safe_k = this
obtain ts⇩k 𝒮⇩k m⇩k where c_k: "c (n + k) = (ts⇩k,m⇩k,𝒮⇩k)"
by (cases "c (n + k)")
obtain ts⇩k' 𝒮⇩k' m⇩k' where c_suc_k: "c (n + (Suc k)) = (ts⇩k',m⇩k',𝒮⇩k')"
by (cases "c (n + (Suc k))")
obtain u_ts⇩k u_shared⇩k u_m⇩k where c'_k: "c' (n + k) = (u_ts⇩k, u_m⇩k, u_shared⇩k)"
by (cases "c' (n + k)")
from trace_preserves_length_ts [OF trace_k, of k 0] c_n c_k i_bound
have i_bound_k: "i < length ts⇩k"
by simp
from leq_l [rule_format, simplified l_k, of k] c_k c'_k
have leq: "length u_ts⇩k = length ts⇩k"
by simp
note last_step = last_step [simplified c_k c_suc_k]
from unchanged_suc_k c_suc_k
have "ts⇩k'!i = ts!i"
by auto
moreover from unchanged_k [rule_format, of k] c_k
have unch_k_i: "ts⇩k!i=ts!i"
by auto
ultimately have ts_eq: "ts⇩k!i=ts⇩k'!i"
by simp
from unchanged_i [simplified l_k, rule_format, OF _ c_k c'_k]
obtain
u_ts_eq: "u_ts⇩k ! i = u_ts ! i" and
unchanged_shared: "∀a∈u_owns. u_shared⇩k a = u_shared a" and
unchanged_shared_orig: "∀a∈u_owns. 𝒮⇩k a = 𝒮 a" and
unchanged_owns: "∀a∈u_owns. u_m⇩k a = u_m a" and
unchanged_owns_orig: "∀a∈u_owns. m⇩k a = m a"
by fastforce
from u_ts_eq u_ts_i
have u_ts⇩k_i: "u_ts⇩k!i=(u_p,u_is,u_tmps,u_sb,u_dirty,u_owns,u_rels)"
by auto
from sim [simplified l_k, rule_format, of k, OF _ c_k c'_k]
obtain
ts_sim: "(∀j<length ts⇩k. j ≠ i ⟶ u_ts⇩k ! j = ts⇩k ! j)" and
shared_sim: "(∀a. a ∉ u_owns ⟶ a ∉ owned (ts⇩k!i) ⟶ u_shared⇩k a = 𝒮⇩k a)" and
mem_sim: "(∀a. a ∉ u_owns ⟶ u_m⇩k a = m⇩k a)"
by (auto simp add: unch_k_i)
from unchanged_owns_orig unchanged_owns u_m_shared unchanged_shared
have unchanged_owns_shared: "∀a. a ∈ u_owns ⟶ a ∈ dom u_shared⇩k ⟶ u_m⇩k a = m⇩k a"
by (auto simp add: simp add: domIff)
from safe_l l_k safe_k
have safe_up_k: "∀x<k. safe_delayed (c' (n + x))"
apply clarsimp
done
from trace_preserves_simple_ownership_distinct [OF _ trace_c'_l [simplified l_k] safe_up_k,
simplified c'_n, simplified, OF dist, of k] c'_k
have dist': "simple_ownership_distinct u_ts⇩k"
by simp
from trace_preserves_simple_ownership_distinct [OF _ trace_k, simplified c_n, simplified, OF dist_ts safe_orig, of k]
c_k
have dist_orig': "simple_ownership_distinct ts⇩k"
by simp
from undo_local_step [OF last_step i_bound_k ts_eq safe_k [simplified c'_k] leq ts_sim u_ts⇩k_i mem_sim
unchanged_owns_shared shared_sim dist' dist_orig']
obtain u_ts' u_shared' u_m' where
step': "(u_ts⇩k, u_m⇩k, u_shared⇩k) ⇒⇩d (u_ts', u_m', u_shared')" and
ts_eq': "u_ts' ! i = u_ts⇩k ! i" and
unchanged_shared': "(∀a∈u_owns. u_shared' a = u_shared⇩k a)" and
unchanged_shared_orig': "(∀a∈u_owns. 𝒮⇩k' a = 𝒮⇩k a)" and
unchanged_owns': "(∀a∈u_owns. u_m' a = u_m⇩k a)" and
unchanged_owns_orig': "(∀a∈u_owns. m⇩k' a = m⇩k a)" and
sim_ts': "(∀j<length ts⇩k. j ≠ i ⟶ u_ts' ! j = ts⇩k' ! j)" and
sim_shared': "(∀a. a ∉ u_owns ⟶ a ∉ owned (ts⇩k ! i) ⟶ u_shared' a = 𝒮⇩k' a)" and
sim_m': "(∀a. a ∉ u_owns ⟶ u_m' a = m⇩k' a)"
by auto
define c'' where "c'' == λl. if l ≤ n + k then c' l else (u_ts', u_m', u_shared')"
have [simp]: "∀x ≤ n + k. c'' x = c' x"
by (auto simp add: c''_def)
have [simp]: "c'' (Suc (n + k)) = (u_ts', u_m', u_shared')"
by (auto simp add: c''_def)
from trace_c'_l l_k step' c'_k have trace': "trace c'' n (Suc k)"
apply (simp add: program_trace_def)
apply (clarsimp simp add: split_less_Suc)
done
from direct_computation.step_preserves_length_ts [OF last_step]
have leq_ts⇩k': "length ts⇩k' = length ts⇩k".
with direct_computation.step_preserves_length_ts [OF step'] leq
have leq': "length u_ts' = length ts⇩k"
by simp
show ?thesis
apply (rule_tac x=c'' in exI)
apply (rule_tac x="Suc k" in exI)
using safe_l l_k unchanged_i sim c_suc_k leq_l c'_n leq'
apply (clarsimp simp add: split_less_Suc split_le_Suc safe_k trace' leq_ts⇩k' sim_ts' sim_shared' sim_m' unch_k_i
ts_eq' u_ts_eq
unchanged_shared' unchanged_shared unchanged_shared_orig unchanged_shared_orig'
unchanged_owns' unchanged_owns
unchanged_owns_orig' unchanged_owns_orig )
done
qed
qed
qed
locale program_safe_reach_upto = program +
fixes n fixes safe fixes c⇩0
assumes safe_config: "⟦k ≤ n; trace c 0 k; c 0 = c⇩0; l ≤ k ⟧ ⟹ safe (c l)"
abbreviation (in program)
"safe_reach_upto ≡ program_safe_reach_upto program_step"
lemma (in program) safe_reach_upto_le:
assumes safe: "safe_reach_upto n safe c⇩0"
assumes m_n: "m ≤ n"
shows "safe_reach_upto m safe c⇩0"
using safe m_n
apply (clarsimp simp add: program_safe_reach_upto_def)
subgoal for k c
apply (subgoal_tac "k ≤ n")
apply blast
apply simp
done
done
lemma (in program) last_action_of_thread:
assumes trace: "trace c 0 k"
shows
"
(∀l ≤ k. fst (c l)!i = fst (c k)!i) ∨
(∃last < k.
fst (c last)!i ≠ fst (c (Suc last))!i ∧
(∀l. last < l ⟶ l ≤ k ⟶ fst (c l)!i = fst (c k)!i)) "
using trace
proof (induct k)
case 0 thus ?case
by auto
next
case (Suc k)
hence "trace c 0 (Suc k)" by simp
then
obtain
trace_k: "trace c 0 k" and
last_step: "c k ⇒⇩d c (Suc k) "
by (clarsimp simp add: program_trace_def)
show ?case
proof (cases "fst (c k)!i = fst (c (Suc k))!i")
case False
then show ?thesis
apply -
apply (rule disjI2)
apply (rule_tac x=k in exI)
apply clarsimp
apply (subgoal_tac "l=Suc k")
apply auto
done
next
case True
note idle_i = this
{
assume same: "(∀l≤k. fst (c l) ! i = fst (c k) ! i)"
have ?thesis
apply -
apply (rule disjI1)
apply clarsimp
apply (case_tac "l=Suc k")
apply (simp add: idle_i)
apply (rule same [simplified idle_i, rule_format])
apply simp
done
}
moreover
{
fix last
assume last_k: "last < k"
assume last_step: "fst (c last) ! i ≠ fst (c (Suc last)) ! i"
assume idle: "(∀l>last. l ≤ k ⟶ fst (c l) ! i = fst (c k) ! i)"
have ?thesis
apply -
apply (rule disjI2)
apply (rule_tac x=last in exI)
using last_k
apply (simp add: last_step)
using idle [simplified idle_i]
apply clarsimp
apply (case_tac "l=Suc k")
apply clarsimp
apply clarsimp
done
}
moreover note Suc.hyps [OF trace_k]
ultimately
show ?thesis
by blast
qed
qed
lemma (in program) sequence_traces:
assumes trace1: "trace c⇩1 0 k"
assumes trace2: "trace c⇩2 m l"
assumes seq: "c⇩2 m = c⇩1 k"
assumes c_def: "c = (λx. if x ≤ k then c⇩1 x else (c⇩2 (m + x -k)))"
shows "trace c 0 (k + l)"
proof -
from trace1
interpret trace1: program_trace program_step c⇩1 0 k .
from trace2
interpret trace2: program_trace program_step c⇩2 m l .
{
fix x
assume x_bound: "x < (k + l)"
have "c x ⇒⇩d c (Suc x)"
proof (cases "x < k")
case True
from trace1.step [OF True] True
show ?thesis
by (simp add: c_def)
next
case False
hence k_x: "k ≤ x"
by auto
with x_bound have bound: "x - k < l"
by auto
from k_x have eq: "(Suc (m + x) - k) = Suc (m + x - k)"
by simp
from trace2.step [OF bound] k_x seq
show ?thesis
by (auto simp add: c_def eq)
qed
}
thus ?thesis
by (auto simp add: program_trace_def)
qed
theorem (in program_progress) safe_free_flowing_implies_safe_delayed:
assumes init: "initial c⇩0"
assumes dist: "simple_ownership_distinct (fst c⇩0)"
assumes read_only_unowned: "read_only_unowned (snd (snd c⇩0)) (fst c⇩0)"
assumes unowned_shared: "unowned_shared (snd (snd c⇩0)) (fst c⇩0)"
assumes safe_reach_ff: "safe_reach_upto n safe_free_flowing c⇩0"
shows "safe_reach_upto n safe_delayed c⇩0"
using safe_reach_ff
proof (induct n)
case 0
hence "safe_reach_upto 0 safe_free_flowing c⇩0" by simp
hence "safe_free_flowing c⇩0"
by (auto simp add: program_safe_reach_upto_def)
from initial_safe_free_flowing_implies_safe_delayed [OF init this]
have "safe_delayed c⇩0".
then show ?case
by (simp add: program_safe_reach_upto_def)
next
case (Suc n)
hence safe_reach_suc: "safe_reach_upto (Suc n) safe_free_flowing c⇩0" by simp
then interpret safe_reach_suc_inter: program_safe_reach_upto program_step "(Suc n)" safe_free_flowing c⇩0 .
from safe_reach_upto_le [OF safe_reach_suc ]
have safe_reach_n: "safe_reach_upto n safe_free_flowing c⇩0" by simp
from Suc.hyps [OF this]
have safe_delayed_reach_n: "safe_reach_upto n safe_delayed c⇩0".
then interpret safe_delayed_reach_inter: program_safe_reach_upto program_step "n" safe_delayed c⇩0 .
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
show ?case
proof (cases "safe_reach_upto (Suc n) safe_delayed c⇩0")
case True thus ?thesis .
next
case False
from safe_delayed_reach_n False
obtain c where
trace: "trace c 0 (Suc n)" and
c_0: "c 0 = c⇩0" and
safe_delayed_upto_n: "∀k≤n. safe_delayed (c k)" and
violation_delayed_suc: "¬ safe_delayed (c (Suc n))"
proof -
from False
obtain c k l where
k_suc: "k ≤ Suc n" and
trace_k: "trace c 0 k" and
l_k: "l ≤ k" and
violation: "¬ safe_delayed (c l)" and
start: "c 0 = c⇩0"
by (clarsimp simp add: program_safe_reach_upto_def)
show ?thesis
proof (cases "k = Suc n")
case False
with k_suc have "k ≤ n"
by auto
from safe_delayed_reach_inter.safe_config [where c=c, OF this trace_k start l_k]
have "safe_delayed (c l)".
with violation have False by simp
thus ?thesis ..
next
case True
note k_suc_n = this
from trace_k True have trace_n: "trace c 0 n"
by (auto simp add: program_trace_def)
show ?thesis
proof (cases "l=Suc n")
case False
with k_suc_n l_k have "l ≤ n" by simp
from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n start this ]
have "safe_delayed (c l)" by simp
with violation have False by simp
thus ?thesis ..
next
case True
from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n start]
have "∀k≤n. safe_delayed (c k)" by simp
with True k_suc_n trace_k start violation
show ?thesis
apply -
apply (rule that)
apply auto
done
qed
qed
qed
from trace
interpret trace_inter: program_trace program_step c 0 "Suc n" .
from safe_reach_suc_inter.safe_config [where c=c, OF _ trace c_0]
have safe_suc: "safe_free_flowing (c (Suc n))"
by auto
obtain ts 𝒮 m where c_suc: "c (Suc n) = (ts,m,𝒮)" by (cases "c (Suc n)")
from violation_delayed_suc c_suc
obtain i p "is" θ sb 𝒟 𝒪 ℛ where
i_bound: "i < length ts" and
ts_i: "ts ! i = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
violation_i: "¬ map owned ts,map released ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√ "
by (fastforce simp add: safe_free_flowing_def safe_delayed_def)
from trace_preserves_unowned_shared [where c=c and n=0 and l="Suc n",
simplified c_0, OF dist unowned_shared trace] safe_delayed_upto_n c_suc
have "unowned_shared 𝒮 ts" by auto
then interpret unowned_shared 𝒮 ts .
from violation_i obtain ins is' where "is": "is = ins#is'"
by (cases "is") (auto simp add: safe_delayed_direct_memop_state.Nil)
from safeE [OF safe_suc [simplified c_suc] i_bound ts_i]
have safe_i: "map owned ts,i⊢(is, θ, m, 𝒟, 𝒪, 𝒮)√".
define races where "races == λℛ. (case ins of
Read volatile a t ⇒ (ℛ a = Some False) ∨ (¬ volatile ∧ a ∈ dom ℛ)
| Write volatile a sop A L R W ⇒ (a ∈ dom ℛ ∨ (volatile ∧ A ∩ dom ℛ ≠ {}))
| Ghost A L R W ⇒ (A ∩ dom ℛ ≠ {})
| RMW a t (D,f) cond ret A L R W ⇒ (if cond (θ(t ↦ m a))
then a ∈ dom ℛ ∨ A ∩ dom ℛ ≠ {}
else ℛ a = Some False)
| _ ⇒ False)"
{
assume no_race:
"∀ j. j < length ts ⟶ j≠i ⟶ ¬ races (released (ts!j))"
from safe_i
have "map owned ts,map released ts,i ⊢(is,θ,m,𝒟,𝒪,𝒮)√ "
proof cases
case Read
thus ?thesis
using "is" no_race
by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
next
case WriteNonVolatile
thus ?thesis
using "is" no_race
by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
next
case WriteVolatile
thus ?thesis
using "is" no_race
apply (clarsimp simp add: races_def)
apply (rule safe_delayed_direct_memop_state.intros)
apply auto
done
next
case Fence
thus ?thesis
using "is" no_race
by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
next
case Ghost
thus ?thesis
using "is" no_race
apply (clarsimp simp add: races_def)
apply (rule safe_delayed_direct_memop_state.intros)
apply auto
done
next
case RMWReadOnly
thus ?thesis
using "is" no_race
by (auto simp add: races_def intro: safe_delayed_direct_memop_state.intros)
next
case (RMWWrite cond t a _ _ A _ 𝒪)
thus ?thesis
using "is" no_race unowned_shared' [rule_format, of a] ts_i
apply (clarsimp simp add: races_def)
apply (rule safe_delayed_direct_memop_state.RMWWrite)
apply auto
apply force
done
next
case Nil with "is" show ?thesis by auto
qed
}
with violation_i
obtain j where
j_bound: "j < length ts" and
neq_j_i: "j ≠ i" and
race: "races (released (ts!j))"
by auto
obtain p⇩j "is⇩j" θ⇩j sb⇩j 𝒟⇩j 𝒪⇩j ℛ⇩j where
ts_j: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
apply (cases "ts!j")
apply force
done
from race
have ℛ⇩j_non_empty: "ℛ⇩j ≠ Map.empty"
by (auto simp add: ts_j races_def split: instr.splits if_split_asm)
{
assume idle_j: "∀l≤Suc n. fst (c l) ! j = fst (c (Suc n)) ! j"
have ?thesis
proof -
from idle_j [rule_format, of 0] c_suc c_0 ts_j
have c⇩0_j: "fst c⇩0 ! j = ts!j"
by clarsimp
from trace_preserves_length_ts [OF trace, of 0 "Suc n"] c_0 c_suc
have "length (fst c⇩0) = length ts"
by clarsimp
with j_bound have "j < length (fst c⇩0)"
by simp
with nth_mem [OF this] init c⇩0_j ts_j
have "ℛ⇩j = Map.empty"
by (auto simp add: initial_def)
with ℛ⇩j_non_empty have False
by simp
thus ?thesis ..
qed
}
moreover
{
fix last
assume last_bound: "last<Suc n"
assume last_step_changed_j: "fst (c last) ! j ≠ fst (c (Suc last)) ! j"
assume idle_rest: "∀l>last. l ≤ Suc n ⟶ fst (c l) ! j = fst (c (Suc n)) ! j"
have ?thesis
proof -
obtain ts⇩l 𝒮⇩l m⇩l where
c_last: "c last = (ts⇩l,m⇩l,𝒮⇩l)"
by (cases "c last")
obtain ts⇩l' 𝒮⇩l' m⇩l' where
c_last': "c (Suc last) = (ts⇩l',m⇩l',𝒮⇩l')"
by (cases "c (Suc last)")
from idle_rest [rule_format, of "Suc last" ] c_suc c_last' last_bound
have ts⇩l'_j: "ts⇩l'!j = ts!j"
by auto
from last_step_changed_j c_last c_last'
have j_changed: "ts⇩l!j ≠ ts⇩l'!j"
by auto
from trace_inter.step [OF last_bound] c_last c_last'
have last_step: "(ts⇩l,m⇩l,𝒮⇩l) ⇒⇩d (ts⇩l',m⇩l',𝒮⇩l')"
by simp
obtain p⇩l "is⇩l" θ⇩l sb⇩l 𝒟⇩l 𝒪⇩l ℛ⇩l where
ts⇩l_j: "ts⇩l!j = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
apply (cases "ts⇩l!j")
apply force
done
from trace_preserves_length_ts [OF trace, of last "Suc n"] c_last c_suc last_bound
have leq⇩l: "length ts⇩l = length ts"
by simp
with j_bound have j_bound⇩l: "j < length ts⇩l"
by simp
from trace have trace_n: "trace c 0 n"
by (auto simp add: program_trace_def)
from safe_delayed_reach_inter.safe_config [where k=n and c=c and l=last, OF _ trace_n c_0] last_bound c_last
have safe_delayed_last: "safe_delayed (ts⇩l,m⇩l,𝒮⇩l)"
by auto
from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0]
have safe_delayed_upto_n: "∀x<n. safe_delayed (c (0 + x))"
by auto
from trace_preserves_simple_ownership_distinct [where c=c and n=0 and l=last,
simplified c_0, OF dist trace_n safe_delayed_upto_n]
last_bound c_last
have dist_last: "simple_ownership_distinct ts⇩l"
by auto
from trace_preserves_read_only_unowned [where c=c and n=0 and l=last,
simplified c_0, OF dist read_only_unowned trace_n safe_delayed_upto_n]
last_bound c_last
have ro_last_last: "read_only_unowned 𝒮⇩l ts⇩l"
by auto
from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0]
have safe_delayed_upto_suc_n: "∀x<Suc n. safe_delayed (c (0 + x))"
by auto
from trace_preserves_simple_ownership_distinct [where c=c and n=0 and l="Suc last",
simplified c_0, OF dist trace safe_delayed_upto_suc_n]
last_bound c_last'
have dist_last': "simple_ownership_distinct ts⇩l'"
by auto
from trace last_bound have trace_last: "trace c 0 last"
by (auto simp add: program_trace_def)
from trace last_bound have trace_rest: "trace c (Suc last) (n - last)"
by (auto simp add: program_trace_def)
from idle_rest last_bound
have idle_rest':
"∀l≤n - last.
∀ts⇩l 𝒮⇩l m⇩l. c (Suc last + l) = (ts⇩l, m⇩l, 𝒮⇩l) ⟶ ts⇩l ! j = ts⇩l' ! j"
apply clarsimp
apply (drule_tac x="Suc (last + l)" in spec)
apply (auto simp add: c_last' c_suc ts⇩l'_j)
done
from safe_delayed_upto_suc_n [rule_format, of last] last_bound
have safe_delayed_last: "safe_delayed (ts⇩l, m⇩l, 𝒮⇩l)"
by (auto simp add: c_last)
from safe_delayedE [OF this j_bound⇩l ts⇩l_j]
have safe⇩l: "map owned ts⇩l,map released ts⇩l,j⊢(is⇩l, θ⇩l, m⇩l, 𝒟⇩l, 𝒪⇩l, 𝒮⇩l)√".
from safe_delayed_reach_inter.safe_config [where c=c, OF _ trace_n c_0]
have safe_delayed_upto_last: "∀x<n - last. safe_delayed (c (Suc (last + x)))"
by auto
from last_step
show ?thesis
proof (cases)
case (Program i' _ _ _ _ _ _ _ p' is')
with j_changed j_bound⇩l ts⇩l_j
obtain
ts⇩l': "ts⇩l' = ts⇩l[j:=(p',is⇩l@is',θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)]" and
𝒮⇩l': "𝒮⇩l'=𝒮⇩l" and
m⇩l': "m⇩l'=m⇩l" and
prog_step: "θ⇩l⊢ p⇩l →⇩p (p', is')"
by (cases "i'=j") auto
from ts⇩l'_j ts⇩l' ts_j j_bound⇩l
obtain eqs: "p'=p⇩j" "is⇩l@is'=is⇩j" "θ⇩l=θ⇩j" "𝒟⇩l=𝒟⇩j" "𝒪⇩l=𝒪⇩j" "ℛ⇩l=ℛ⇩j"
by auto
from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified ts⇩l',
simplified,
OF j_bound⇩l ts⇩l_j [simplified], simplified m⇩l' 𝒮⇩l', simplified, OF dist_last
dist_last' [simplified ts⇩l',simplified] safe_delayed_upto_last]
obtain c' k where
k_bound: "k ≤ n - last" and
trace_c': "trace c' (Suc last) k" and
c'_first: "c' (Suc last) = (ts⇩l, m⇩l, 𝒮⇩l)" and
c'_leq: "(∀x≤k. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
c'_safe: "(∀x<k. safe_delayed (c' (Suc (last + x))))" and
c'_unsafe: "(k < n - last ⟶ ¬ safe_delayed (c' (Suc (last + k))))" and
c'_unch:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
ts⇩x' ! j = ts⇩l ! j ∧
(∀a∈𝒪⇩l. 𝒮⇩x' a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. 𝒮⇩x a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. m⇩x' a = m⇩l a) ∧ (∀a∈𝒪⇩l. m⇩x a = m⇩l a)))" and
c'_sim:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
(∀ja<length ts⇩x. ja ≠ j ⟶ ts⇩x' ! ja = ts⇩x ! ja) ∧
(∀a. a ∉ 𝒪⇩l ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ 𝒪⇩l ⟶ m⇩x' a = m⇩x a)))"
by auto
obtain c_undo where c_undo: "c_undo = (λx. if x ≤ last then c x else c' (Suc last + x - last))"
by blast
have c_undo_0: "c_undo 0 = c⇩0"
by (auto simp add: c_undo c_0)
from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
have trace_undo: "trace c_undo 0 (last + k)" .
obtain u_ts u_shared u_m where
c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
by (cases "c_undo n")
with last_bound c'_first c_last
have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
apply (auto simp add: c_undo split: if_split_asm)
apply (subgoal_tac "n=last")
apply auto
done
show ?thesis
proof (cases "k < n - last")
case True
with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_last c'_first)
from True have "last + k ≤ n"
by auto
from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
have "safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_0)
with unsafe have False by simp
thus ?thesis ..
next
case False
with k_bound have k: "k = n - last"
by auto
have eq': "Suc (last + (n - last)) = Suc n"
using last_bound
by simp
from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
obtain u_ts_j: "u_ts!j = ts⇩l!j" and
shared_unch: "∀a∈𝒪⇩l. u_shared a = 𝒮⇩l a" and
shared_orig_unch: "∀a∈𝒪⇩l. 𝒮 a = 𝒮⇩l a" and
mem_unch: "∀a∈𝒪⇩l. u_m a = m⇩l a" and
mem_unch_orig: "∀a∈𝒪⇩l. m a = m⇩l a"
by auto
from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
obtain u_ts_i: "u_ts!i = ts!i" and
shared_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_shared a = 𝒮 a" and
mem_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_m a = m a"
by auto
from c'_leq [rule_format, of k] c'_suc c_suc
have leq_u_ts: "length u_ts = length ts"
by (auto simp add: eq' k)
from j_bound leq_u_ts
have j_bound_u: "j < length u_ts"
by simp
from i_bound leq_u_ts
have i_bound_u: "i < length u_ts"
by simp
from k last_bound have l_k_eq: "last + k = n"
by auto
from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq]
k c_0 last_bound
have safe_delayed_c_undo': "∀x≤ n. safe_delayed (c_undo x)"
by (auto simp add: c_undo split: if_split_asm)
hence safe_delayed_c_undo: "∀x<n. safe_delayed (c_undo x)"
by (auto)
from trace_preserves_simple_ownership_distinct [OF _ trace_undo,
simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
have dist_u_ts: "simple_ownership_distinct u_ts"
by auto
then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
{
fix a
have "u_m a = m a"
proof (cases "a ∈ 𝒪⇩l")
case True with mem_unch
have "u_m a = m⇩l a"
by auto
moreover
from True mem_unch_orig
have "m a = m⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with mem_sim
show ?thesis
by auto
qed
} hence u_m_eq: "u_m = m" by - (rule ext, auto)
{
fix a
have "u_shared a = 𝒮 a"
proof (cases "a ∈ 𝒪⇩l")
case True with shared_unch
have "u_shared a = 𝒮⇩l a"
by auto
moreover
from True shared_orig_unch
have "𝒮 a = 𝒮⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with shared_sim
show ?thesis
by auto
qed
} hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto)
{
assume safe: "map owned u_ts,map released u_ts,i ⊢(is,θ,u_m,𝒟,𝒪,u_shared)√ "
then have False
proof cases
case Read
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteNonVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case Fence
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case Ghost
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case (RMWReadOnly cond t a D f ret A L R W)
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
next
case RMWWrite
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
apply fastforce+
done
next
case Nil
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
qed
}
hence "¬ safe_delayed (u_ts, u_m, u_shared)"
apply (clarsimp simp add: safe_delayed_def)
apply (rule_tac x=i in exI)
using u_ts_i ts_i i_bound_u
apply auto
done
moreover
from safe_delayed_c_undo' [rule_format, of n] c_undo_n
have "safe_delayed (u_ts, u_m, u_shared)"
by simp
ultimately have False
by simp
thus ?thesis
by simp
qed
next
case (Memop i' _ _ _ _ _ _ _ "is⇩l'" θ⇩l' sb⇩l' 𝒟⇩l' 𝒪⇩l' ℛ⇩l')
with j_changed j_bound⇩l ts⇩l_j
obtain
ts⇩l': "ts⇩l' = ts⇩l[j:=(p⇩l,is⇩l',θ⇩l',sb⇩l',𝒟⇩l',𝒪⇩l',ℛ⇩l')]" and
mem_step: "(is⇩l, θ⇩l, sb⇩l, m⇩l, 𝒟⇩l, 𝒪⇩l, ℛ⇩l,𝒮⇩l) →
(is⇩l', θ⇩l', sb⇩l', m⇩l', 𝒟⇩l', 𝒪⇩l', ℛ⇩l', 𝒮⇩l')"
by (cases "i'=j") auto
from mem_step
show ?thesis
proof (cases)
case (Read volatile a t)
then obtain
"is⇩l": "is⇩l = Read volatile a t # is⇩l'" and
θ⇩l': "θ⇩l' = θ⇩l(t ↦ m⇩l a)" and
sb⇩l': "sb⇩l'=sb⇩l" and
𝒟⇩l': "𝒟⇩l'=𝒟⇩l" and
𝒪⇩l': "𝒪⇩l' = 𝒪⇩l" and
ℛ⇩l': "ℛ⇩l'= ℛ⇩l" and
𝒮⇩l': "𝒮⇩l'=𝒮⇩l" and
m⇩l': "m⇩l' = m⇩l"
by auto
note eqs' = θ⇩l' sb⇩l' 𝒟⇩l' 𝒪⇩l' ℛ⇩l' 𝒮⇩l' m⇩l'
from ts⇩l'_j ts⇩l' ts_j j_bound⇩l eqs'
obtain eqs: "p⇩l=p⇩j" "is⇩l'=is⇩j" "θ⇩l(t ↦ m⇩l a)=θ⇩j" "𝒟⇩l=𝒟⇩j" "𝒪⇩l=𝒪⇩j" "ℛ⇩l=ℛ⇩j"
by auto
from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified ts⇩l',
simplified,
OF j_bound⇩l ts⇩l_j [simplified], simplified m⇩l' 𝒮⇩l', simplified, OF dist_last
dist_last' [simplified ts⇩l',simplified] safe_delayed_upto_last]
obtain c' k where
k_bound: "k ≤ n - last" and
trace_c': "trace c' (Suc last) k" and
c'_first: "c' (Suc last) = (ts⇩l, m⇩l, 𝒮⇩l)" and
c'_leq: "(∀x≤k. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
c'_safe: "(∀x<k. safe_delayed (c' (Suc (last + x))))" and
c'_unsafe: "(k < n - last ⟶ ¬ safe_delayed (c' (Suc (last + k))))" and
c'_unch:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
ts⇩x' ! j = ts⇩l ! j ∧
(∀a∈𝒪⇩l. 𝒮⇩x' a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. 𝒮⇩x a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. m⇩x' a = m⇩l a) ∧ (∀a∈𝒪⇩l. m⇩x a = m⇩l a)))" and
c'_sim:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
(∀ja<length ts⇩x. ja ≠ j ⟶ ts⇩x' ! ja = ts⇩x ! ja) ∧
(∀a. a ∉ 𝒪⇩l ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ 𝒪⇩l ⟶ m⇩x' a = m⇩x a)))"
by (clarsimp simp add: 𝒪⇩l')
obtain c_undo where c_undo: "c_undo = (λx. if x ≤ last then c x else c' (Suc last + x - last))"
by blast
have c_undo_0: "c_undo 0 = c⇩0"
by (auto simp add: c_undo c_0)
from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
have trace_undo: "trace c_undo 0 (last + k)" .
obtain u_ts u_shared u_m where
c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
by (cases "c_undo n")
with last_bound c'_first c_last
have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
apply (auto simp add: c_undo split: if_split_asm)
apply (subgoal_tac "n=last")
apply auto
done
show ?thesis
proof (cases "k < n - last")
case True
with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_last c'_first)
from True have "last + k ≤ n"
by auto
from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
have "safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_0)
with unsafe have False by simp
thus ?thesis ..
next
case False
with k_bound have k: "k = n - last"
by auto
have eq': "Suc (last + (n - last)) = Suc n"
using last_bound
by simp
from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
obtain u_ts_j: "u_ts!j = ts⇩l!j" and
shared_unch: "∀a∈𝒪⇩l. u_shared a = 𝒮⇩l a" and
shared_orig_unch: "∀a∈𝒪⇩l. 𝒮 a = 𝒮⇩l a" and
mem_unch: "∀a∈𝒪⇩l. u_m a = m⇩l a" and
mem_unch_orig: "∀a∈𝒪⇩l. m a = m⇩l a"
by auto
from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
obtain u_ts_i: "u_ts!i = ts!i" and
shared_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_shared a = 𝒮 a" and
mem_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_m a = m a"
by auto
from c'_leq [rule_format, of k] c'_suc c_suc
have leq_u_ts: "length u_ts = length ts"
by (auto simp add: eq' k)
from j_bound leq_u_ts
have j_bound_u: "j < length u_ts"
by simp
from i_bound leq_u_ts
have i_bound_u: "i < length u_ts"
by simp
from k last_bound have l_k_eq: "last + k = n"
by auto
from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq]
k c_0 last_bound
have safe_delayed_c_undo': "∀x≤n. safe_delayed (c_undo x)"
by (auto simp add: c_undo split: if_split_asm)
hence safe_delayed_c_undo: "∀x<n. safe_delayed (c_undo x)"
by (auto)
from trace_preserves_simple_ownership_distinct [OF _ trace_undo,
simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
have dist_u_ts: "simple_ownership_distinct u_ts"
by auto
then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
{
fix a
have "u_m a = m a"
proof (cases "a ∈ 𝒪⇩l")
case True with mem_unch
have "u_m a = m⇩l a"
by auto
moreover
from True mem_unch_orig
have "m a = m⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with mem_sim
show ?thesis
by auto
qed
} hence u_m_eq: "u_m = m" by - (rule ext, auto)
{
fix a
have "u_shared a = 𝒮 a"
proof (cases "a ∈ 𝒪⇩l")
case True with shared_unch
have "u_shared a = 𝒮⇩l a"
by auto
moreover
from True shared_orig_unch
have "𝒮 a = 𝒮⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with shared_sim
show ?thesis
by auto
qed
} hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto)
{
assume safe: "map owned u_ts,map released u_ts,i ⊢(is,θ,u_m,𝒟,𝒪,u_shared)√ "
then have False
proof cases
case Read
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteNonVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case Fence
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case Ghost
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case (RMWReadOnly cond t a D f ret A L R W)
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
next
case RMWWrite
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
apply fastforce+
done
next
case Nil
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
qed
}
hence "¬ safe_delayed (u_ts, u_m, u_shared)"
apply (clarsimp simp add: safe_delayed_def)
apply (rule_tac x=i in exI)
using u_ts_i ts_i i_bound_u
apply auto
done
moreover
from safe_delayed_c_undo' [rule_format, of n] c_undo_n
have "safe_delayed (u_ts, u_m, u_shared)"
by simp
ultimately have False
by simp
thus ?thesis
by simp
qed
next
case (WriteNonVolatile a D f A L R W)
then obtain
"is⇩l": "is⇩l = Write False a (D, f) A L R W # is⇩l'" and
θ⇩l': "θ⇩l' = θ⇩l" and
sb⇩l': "sb⇩l'=sb⇩l" and
𝒟⇩l': "𝒟⇩l'=𝒟⇩l" and
𝒪⇩l': "𝒪⇩l' = 𝒪⇩l" and
ℛ⇩l': "ℛ⇩l'= ℛ⇩l" and
𝒮⇩l': "𝒮⇩l'=𝒮⇩l" and
m⇩l': "m⇩l' = m⇩l(a:=f θ⇩l)"
by auto
note eqs' = θ⇩l' sb⇩l' 𝒟⇩l' 𝒪⇩l' ℛ⇩l' 𝒮⇩l' m⇩l'
from ts⇩l'_j ts⇩l' ts_j j_bound⇩l eqs'
obtain eqs: "p⇩l=p⇩j" "is⇩l'=is⇩j" "θ⇩l=θ⇩j" "𝒟⇩l=𝒟⇩j" "𝒪⇩l=𝒪⇩j"
"ℛ⇩l=ℛ⇩j"
by auto
from safe⇩l [simplified "is⇩l"]
obtain a_owned: "a ∈ 𝒪⇩l" and a_unshared: "a ∉ dom 𝒮⇩l"
by cases auto
have m⇩l_unch_unowned: "∀a'. a' ∉ 𝒪⇩l ⟶ m⇩l a' = (m⇩l(a := f θ⇩l)) a'"
using a_owned by auto
have m⇩l_unch_unshared: "∀a'. a' ∈ 𝒪⇩l ⟶ a' ∈ dom 𝒮⇩l ⟶ m⇩l a' = (m⇩l(a := f θ⇩l)) a'"
using a_unshared by auto
from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified ts⇩l',
simplified,
OF j_bound⇩l ts⇩l_j [simplified], simplified m⇩l' 𝒮⇩l',OF m⇩l_unch_unowned m⇩l_unch_unshared, simplified,
OF dist_last dist_last' [simplified ts⇩l',simplified] safe_delayed_upto_last]
obtain c' k where
k_bound: "k ≤ n - last" and
trace_c': "trace c' (Suc last) k" and
c'_first: "c' (Suc last) = (ts⇩l, m⇩l, 𝒮⇩l)" and
c'_leq: "(∀x≤k. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
c'_safe: "(∀x<k. safe_delayed (c' (Suc (last + x))))" and
c'_unsafe: "(k < n - last ⟶ ¬ safe_delayed (c' (Suc (last + k))))" and
c'_unch:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
ts⇩x' ! j = ts⇩l ! j ∧
(∀a∈𝒪⇩l. 𝒮⇩x' a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. 𝒮⇩x a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. m⇩x' a = m⇩l a) ∧ (∀a'∈𝒪⇩l. m⇩x a' = (m⇩l(a := f θ⇩l)) a')))" and
c'_sim:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
(∀ja<length ts⇩x. ja ≠ j ⟶ ts⇩x' ! ja = ts⇩x ! ja) ∧
(∀a. a ∉ 𝒪⇩l ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ 𝒪⇩l ⟶ m⇩x' a = m⇩x a)))"
by (clarsimp simp add: 𝒪⇩l')
obtain c_undo where c_undo: "c_undo = (λx. if x ≤ last then c x else c' (Suc last + x - last))"
by blast
have c_undo_0: "c_undo 0 = c⇩0"
by (auto simp add: c_undo c_0)
from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
have trace_undo: "trace c_undo 0 (last + k)" .
obtain u_ts u_shared u_m where
c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
by (cases "c_undo n")
with last_bound c'_first c_last
have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
apply (auto simp add: c_undo split: if_split_asm)
apply (subgoal_tac "n=last")
apply auto
done
show ?thesis
proof (cases "k < n - last")
case True
with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_last c'_first)
from True have "last + k ≤ n"
by auto
from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
have "safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_0)
with unsafe have False by simp
thus ?thesis ..
next
case False
with k_bound have k: "k = n - last"
by auto
have eq': "Suc (last + (n - last)) = Suc n"
using last_bound
by simp
from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
obtain u_ts_j: "u_ts!j = ts⇩l!j" and
shared_unch: "∀a∈𝒪⇩l. u_shared a = 𝒮⇩l a" and
shared_orig_unch: "∀a∈𝒪⇩l. 𝒮 a = 𝒮⇩l a" and
mem_unch: "∀a∈𝒪⇩l. u_m a = m⇩l a" and
mem_unch_orig: "∀a'∈𝒪⇩l. m a' = (m⇩l(a := f θ⇩l)) a'"
by auto
from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
obtain u_ts_i: "u_ts!i = ts!i" and
shared_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_shared a = 𝒮 a" and
mem_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_m a = m a"
by auto
from c'_leq [rule_format, of k] c'_suc c_suc
have leq_u_ts: "length u_ts = length ts"
by (auto simp add: eq' k)
from j_bound leq_u_ts
have j_bound_u: "j < length u_ts"
by simp
from i_bound leq_u_ts
have i_bound_u: "i < length u_ts"
by simp
from k last_bound have l_k_eq: "last + k = n"
by auto
from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq]
k c_0 last_bound
have safe_delayed_c_undo': "∀x≤n. safe_delayed (c_undo x)"
by (auto simp add: c_undo split: if_split_asm)
hence safe_delayed_c_undo: "∀x<n. safe_delayed (c_undo x)"
by auto
from trace_preserves_simple_ownership_distinct [OF _ trace_undo,
simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
have dist_u_ts: "simple_ownership_distinct u_ts"
by auto
then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
{
fix a
have "u_shared a = 𝒮 a"
proof (cases "a ∈ 𝒪⇩l")
case True with shared_unch
have "u_shared a = 𝒮⇩l a"
by auto
moreover
from True shared_orig_unch
have "𝒮 a = 𝒮⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with shared_sim
show ?thesis
by auto
qed
} hence u_shared_eq: "u_shared = 𝒮" by - (rule ext, auto)
{
assume safe: "map owned u_ts,map released u_ts,i ⊢(is,θ,u_m,𝒟,𝒪,u_shared)√ "
then have False
proof cases
case Read
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteNonVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case WriteVolatile
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case Fence
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case Ghost
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def split: if_split_asm)
apply fastforce
done
next
case (RMWReadOnly cond t a' D f ret A L R W)
with ts_i "is" obtain
ins: "ins = RMW a' t (D, f) cond ret A L R W" and
owned_or_shared: "a' ∈ 𝒪 ∨ a' ∈ dom u_shared" and
cond: "¬ cond (θ(t ↦ u_m a'))" and
rels_race: "∀j<length (map owned u_ts). i ≠ j ⟶ ((map released u_ts) ! j) a' ≠ Some False"
by auto
from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified ts⇩l_j]
u_ts_i [simplified ts_i]]
have dist: "𝒪⇩l ∩ 𝒪 = {}"
by auto
from owned_or_shared dist a_owned a_unshared shared_orig_unch
have a'_a: "a'≠a"
by (auto simp add: u_shared_eq domIff)
have u_m_eq: "u_m a' = m a'"
proof (cases "a' ∈ 𝒪⇩l")
case True with mem_unch
have "u_m a' = m⇩l a'"
by auto
moreover
from True mem_unch_orig a'_a
have "m a' = m⇩l a'"
by auto
ultimately show ?thesis by simp
next
case False
with mem_sim
show ?thesis
by auto
qed
with ins cond rels_race show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
next
case (RMWWrite cond t a' A L R D f ret W)
with ts_i "is" obtain
ins: "ins = RMW a' t (D, f) cond ret A L R W" and
cond: "cond (θ(t ↦ u_m a'))" and
a': "∀j<length (map owned u_ts). i ≠ j ⟶ a' ∉ (map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)" and
safety:
"A ⊆ dom u_shared ∪ 𝒪" "L ⊆ A" "R ⊆ 𝒪" "A ∩ R = {}"
"∀j<length (map owned u_ts). i ≠ j ⟶ A ∩ ((map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)) = {}"
"a' ∉ read_only u_shared"
by auto
from a'[rule_format, of j] j_bound_u u_ts_j ts⇩l_j neq_j_i
have "a' ∉ 𝒪⇩l"
by auto
from mem_sim [rule_format, OF this]
have u_m_eq: "u_m a' = m a'"
by auto
with ins cond safety a' show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
apply (auto simp add:eqs races_def u_shared_eq u_m_eq split: if_split_asm)
apply fastforce
done
next
case Nil
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
qed
}
hence "¬ safe_delayed (u_ts, u_m, u_shared)"
apply (clarsimp simp add: safe_delayed_def)
apply (rule_tac x=i in exI)
using u_ts_i ts_i i_bound_u
apply auto
done
moreover
from safe_delayed_c_undo' [rule_format, of n] c_undo_n
have "safe_delayed (u_ts, u_m, u_shared)"
by simp
ultimately have False
by simp
thus ?thesis
by simp
qed
next
case WriteVolatile
with ts⇩l'_j ts⇩l' ts_j j_bound⇩l have "ℛ⇩j = Map.empty"
by auto
with ℛ⇩j_non_empty have False by auto
thus ?thesis ..
next
case Fence
with ts⇩l'_j ts⇩l' ts_j j_bound⇩l have "ℛ⇩j = Map.empty"
by auto
with ℛ⇩j_non_empty have False by auto
thus ?thesis ..
next
case RMWReadOnly
with ts⇩l'_j ts⇩l' ts_j j_bound⇩l have "ℛ⇩j = Map.empty"
by auto
with ℛ⇩j_non_empty have False by auto
thus ?thesis ..
next
case RMWWrite
with ts⇩l'_j ts⇩l' ts_j j_bound⇩l have "ℛ⇩j = Map.empty"
by auto
with ℛ⇩j_non_empty have False by auto
thus ?thesis ..
next
case (Ghost A L R W)
then obtain
"is⇩l": "is⇩l = Ghost A L R W # is⇩l'" and
θ⇩l': "θ⇩l' = θ⇩l" and
sb⇩l': "sb⇩l'=sb⇩l" and
𝒟⇩l': "𝒟⇩l'=𝒟⇩l" and
𝒪⇩l': "𝒪⇩l' = 𝒪⇩l ∪ A - R" and
ℛ⇩l': "ℛ⇩l'= augment_rels (dom 𝒮⇩l) R ℛ⇩l" and
𝒮⇩l': "𝒮⇩l'=𝒮⇩l ⊕⇘W⇙ R ⊖⇘A⇙ L" and
m⇩l': "m⇩l' = m⇩l"
by auto
note eqs' = θ⇩l' sb⇩l' 𝒟⇩l' 𝒪⇩l' ℛ⇩l' 𝒮⇩l' m⇩l'
from ts⇩l'_j ts⇩l' ts_j j_bound⇩l eqs'
obtain eqs: "p⇩l=p⇩j" "is⇩l'=is⇩j" "θ⇩l=θ⇩j" "𝒟⇩l=𝒟⇩j" "𝒪⇩l ∪ A - R = 𝒪⇩j"
"augment_rels (dom 𝒮⇩l) R ℛ⇩l=ℛ⇩j"
by auto
from safe⇩l [simplified "is⇩l"]
obtain
A_shared_owned: "A ⊆ dom 𝒮⇩l ∪ 𝒪⇩l" and L_A: "L ⊆ A" and R_owns: "R ⊆ 𝒪⇩l" and A_R: "A ∩ R = {}" and
"∀j' < length (map owned ts⇩l). j≠j' ⟶ A ∩ ((map owned ts⇩l)!j' ∪ dom ((map released ts⇩l)!j')) = {}"
by cases auto
from A_shared_owned L_A R_owns A_R
have shared_eq: "∀a. a ∉ 𝒪⇩l ⟶ a ∉ 𝒪⇩l' ⟶ 𝒮⇩l a = (𝒮⇩l ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: restrict_shared_def augment_shared_def 𝒪⇩l' split: option.splits)
from undo_local_steps [where c=c, OF trace_rest c_last' idle_rest' safe_delayed_last, simplified ts⇩l',
simplified,
OF j_bound⇩l ts⇩l_j [simplified], simplified m⇩l' 𝒮⇩l', simplified,
OF shared_eq dist_last dist_last' [simplified ts⇩l',simplified] safe_delayed_upto_last]
obtain c' k where
k_bound: "k ≤ n - last" and
trace_c': "trace c' (Suc last) k" and
c'_first: "c' (Suc last) = (ts⇩l, m⇩l, 𝒮⇩l)" and
c'_leq: "(∀x≤k. length (fst (c' (Suc (last + x)))) = length (fst (c (Suc (last + x)))))" and
c'_safe: "(∀x<k. safe_delayed (c' (Suc (last + x))))" and
c'_unsafe: "(k < n - last ⟶ ¬ safe_delayed (c' (Suc (last + k))))" and
c'_unch:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
ts⇩x' ! j = ts⇩l ! j ∧
(∀a∈𝒪⇩l. 𝒮⇩x' a = 𝒮⇩l a) ∧
(∀a∈𝒪⇩l. 𝒮⇩x a = (𝒮⇩l ⊕⇘W⇙ R ⊖⇘A⇙ L) a) ∧
(∀a∈𝒪⇩l. m⇩x' a = m⇩l a) ∧ (∀a'∈𝒪⇩l. m⇩x a' = (m⇩l) a')))" and
c'_sim:
"(∀x≤k. ∀ts⇩x 𝒮⇩x m⇩x.
c (Suc (last + x)) = (ts⇩x, m⇩x, 𝒮⇩x) ⟶
(∀ts⇩x' 𝒮⇩x' m⇩x'.
c' (Suc (last + x)) = (ts⇩x', m⇩x', 𝒮⇩x') ⟶
(∀ja<length ts⇩x. ja ≠ j ⟶ ts⇩x' ! ja = ts⇩x ! ja) ∧
(∀a. a ∉ 𝒪⇩l ⟶ a ∉ 𝒪⇩l' ⟶ 𝒮⇩x' a = 𝒮⇩x a) ∧
(∀a. a ∉ 𝒪⇩l ⟶ m⇩x' a = m⇩x a)))"
by (clarsimp )
obtain c_undo where c_undo: "c_undo = (λx. if x ≤ last then c x else c' (Suc last + x - last))"
by blast
have c_undo_0: "c_undo 0 = c⇩0"
by (auto simp add: c_undo c_0)
from sequence_traces [OF trace_last trace_c', simplified c_last, OF c'_first c_undo]
have trace_undo: "trace c_undo 0 (last + k)" .
obtain u_ts u_shared u_m where
c_undo_n: "c_undo n = (u_ts,u_m, u_shared)"
by (cases "c_undo n")
with last_bound c'_first c_last
have c'_suc: "c' (Suc n) = (u_ts,u_m, u_shared)"
apply (auto simp add: c_undo split: if_split_asm)
apply (subgoal_tac "n=last")
apply auto
done
show ?thesis
proof (cases "k < n - last")
case True
with c'_unsafe have unsafe: "¬ safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_last c'_first)
from True have "last + k ≤ n"
by auto
from safe_delayed_reach_inter.safe_config [OF this trace_undo, of "last + k"]
have "safe_delayed (c_undo (last + k))"
by (auto simp add: c_undo c_0)
with unsafe have False by simp
thus ?thesis ..
next
case False
with k_bound have k: "k = n - last"
by auto
have eq': "Suc (last + (n - last)) = Suc n"
using last_bound
by simp
from c'_unch [rule_format, of k, simplified k eq', OF _ c_suc c'_suc]
obtain u_ts_j: "u_ts!j = ts⇩l!j" and
shared_unch: "∀a∈𝒪⇩l. u_shared a = 𝒮⇩l a" and
shared_orig_unch: "∀a∈𝒪⇩l. 𝒮 a = (𝒮⇩l ⊕⇘W⇙ R ⊖⇘A⇙ L) a" and
mem_unch: "∀a∈𝒪⇩l. u_m a = m⇩l a" and
mem_unch_orig: "∀a'∈𝒪⇩l. m a' = m⇩l a'"
by auto
from c'_sim [rule_format, of k, simplified k eq', OF _ c_suc c'_suc] i_bound neq_j_i
obtain u_ts_i: "u_ts!i = ts!i" and
shared_sim: "∀a. a ∉ 𝒪⇩l ⟶ a ∉ 𝒪⇩l' ⟶ u_shared a = 𝒮 a" and
mem_sim: "∀a. a ∉ 𝒪⇩l ⟶ u_m a = m a"
by auto
from c'_leq [rule_format, of k] c'_suc c_suc
have leq_u_ts: "length u_ts = length ts"
by (auto simp add: eq' k)
from j_bound leq_u_ts
have j_bound_u: "j < length u_ts"
by simp
from i_bound leq_u_ts
have i_bound_u: "i < length u_ts"
by simp
from k last_bound have l_k_eq: "last + k = n"
by auto
from safe_delayed_reach_inter.safe_config [OF _ trace_undo, simplified l_k_eq]
k c_0 last_bound
have safe_delayed_c_undo': "∀x≤n. safe_delayed (c_undo x)"
by (auto simp add: c_undo split: if_split_asm)
hence safe_delayed_c_undo: "∀x<n. safe_delayed (c_undo x)"
by auto
from trace_preserves_simple_ownership_distinct [OF _ trace_undo,
simplified l_k_eq c_undo_0, simplified, OF dist this, of n] dist c_undo_n
have dist_u_ts: "simple_ownership_distinct u_ts"
by auto
then interpret dist_u_ts_inter: simple_ownership_distinct u_ts .
{
fix a
have "u_m a = m a"
proof (cases "a ∈ 𝒪⇩l")
case True with mem_unch
have "u_m a = m⇩l a"
by auto
moreover
from True mem_unch_orig
have "m a = m⇩l a"
by auto
ultimately show ?thesis by simp
next
case False
with mem_sim
show ?thesis
by auto
qed
} hence u_m_eq: "u_m = m" by - (rule ext, auto)
{
assume safe: "map owned u_ts,map released u_ts,i ⊢(is,θ,u_m,𝒟,𝒪,u_shared)√ "
then have False
proof cases
case (Read a volatile t)
with ts_i "is" obtain
ins: "ins = Read volatile a t" and
access_cond: "a ∈ 𝒪 ∨ a ∈ read_only u_shared ∨ volatile ∧ a ∈ dom u_shared" and
rels_cond: "∀j<length u_ts. i ≠ j ⟶ ((map released u_ts) ! j) a ≠ Some False" and
rels_non_volatile_cond: "¬ volatile ⟶ (∀j<length u_ts. i ≠ j ⟶ a ∉ dom ((map released u_ts) ! j) )" and
clean: "volatile ⟶ ¬ 𝒟"
by auto
from race ts_j
have rc: "augment_rels (dom 𝒮⇩l) R ℛ⇩l a = Some False ∨
(¬ volatile ∧ a ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l))"
by (auto simp add: races_def ins eqs)
from rels_cond [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
have ℛ⇩l_a: "ℛ⇩l a ≠ Some False"
by auto
from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified ts⇩l_j]
u_ts_i [simplified ts_i]]
have dist: "𝒪⇩l ∩ 𝒪 = {}"
by auto
show ?thesis
proof (cases volatile)
case True
note volatile=this
show ?thesis
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def volatile)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
from shared_unch [rule_format, OF a_owns⇩l]
have u_shared_eq: "u_shared a = 𝒮⇩l a"
by auto
from a_owns⇩l dist have "a ∉ 𝒪"
by auto
moreover
{
assume "a ∈ read_only u_shared"
with u_shared_eq have "𝒮⇩l a = Some False"
by (auto simp add: read_only_def)
with rc True ℛ⇩l_a have False
by (auto simp add: augment_rels_def split: option.splits simp add: domIff volatile)
}
moreover
{
assume "a ∈ dom u_shared"
with u_shared_eq rc True ℛ⇩l_a have False
by (auto simp add: augment_rels_def split: option.splits simp add: domIff volatile)
}
ultimately show False
using access_cond
by auto
qed
next
case False
note non_volatile = this
from rels_non_volatile_cond [rule_format, OF False j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
have ℛ⇩l_a: "ℛ⇩l a = None"
by (auto simp add: domIff)
show ?thesis
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def non_volatile domIff)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
from shared_unch [rule_format, OF a_owns⇩l]
have u_shared_eq: "u_shared a = 𝒮⇩l a"
by auto
from a_owns⇩l dist have a_unowned: "a ∉ 𝒪"
by auto
moreover
from ro_last_last interpret
read_only_unowned 𝒮⇩l ts⇩l .
from read_only_unowned [OF j_bound⇩l ts⇩l_j] a_owns⇩l have a_unsh: "a ∉ read_only 𝒮⇩l" by auto
{
assume "a ∈ read_only u_shared"
with u_shared_eq have sh: "𝒮⇩l a = Some False"
by (auto simp add: read_only_def)
with rc True ℛ⇩l_a access_cond u_shared_eq a_unowned sh a_owns⇩l a_unsh have False
by (auto simp add: augment_rels_def split: option.splits simp add: domIff non_volatile read_only_def)
}
moreover
{
assume "a ∈ dom u_shared"
with u_shared_eq rc True ℛ⇩l_a a_owns⇩l a_unsh access_cond dist have False
by (auto simp add: augment_rels_def split: option.splits simp add: domIff non_volatile read_only_def)
}
ultimately show False
using access_cond
by (auto)
qed
qed
next
case (WriteNonVolatile a D f A' L' R' W')
with ts_i "is" obtain
ins: "ins = Write False a (D, f) A' L' R' W'" and
a_owned: "a ∈ 𝒪" and a_unshared: "a ∉ dom u_shared" and
a_unreleased: "∀j<length u_ts. i ≠ j ⟶ a ∉ dom ((map released u_ts) ! j)"
by auto
from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified ts⇩l_j]
u_ts_i [simplified ts_i]]
have dist: "𝒪⇩l ∩ 𝒪 = {}"
by auto
from race ts_j
have rc: "a ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
by (auto simp add: races_def ins eqs)
from a_unreleased [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
have ℛ⇩l_a: "a ∉ dom ℛ⇩l"
by auto
show False
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
with a_owned dist show False
by auto
qed
next
case (WriteVolatile a A' L' R' D f W')
with ts_i "is" obtain
ins: "ins = Write True a (D, f) A' L' R' W'" and
a_un_owned_released: "∀j<length u_ts. i ≠ j ⟶
a ∉ ((map owned u_ts) ! j) ∧ a ∉ dom ((map released u_ts) ! j)" and
A'_owns_shared: "A' ⊆ dom u_shared ∪ 𝒪" and
L'_A': "L' ⊆ A'" and
R'_owned: "R' ⊆ 𝒪" and
A'_R': "A' ∩ R' = {}" and
acq_ok: "∀j<length u_ts. i ≠ j ⟶ A' ∩ ((map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)) = {}" and
writeable: "a ∉ read_only u_shared"
by auto
from a_un_owned_released [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
obtain 𝒪⇩l_a: "a ∉ 𝒪⇩l" and ℛ⇩l_a: "a ∉ dom (ℛ⇩l)"
by auto
from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
obtain 𝒪⇩l_A': "A' ∩ 𝒪⇩l = {}" and ℛ⇩l_A': "A' ∩ dom (ℛ⇩l) = {}"
by auto
{
assume rc: "a ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
have False
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
with 𝒪⇩l_a show False
by auto
qed
}
moreover
{
assume rc: "A' ∩ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l) ≠ {}"
then obtain a' where a'_A': "a' ∈ A'" and a'_aug: "a' ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
by auto
have False
proof (cases "a' ∈ R")
case False
with a'_aug a'_A' ℛ⇩l_A' show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns have a'_owns⇩l: "a' ∈ 𝒪⇩l"
by auto
with 𝒪⇩l_A' a'_A' show False
by auto
qed
}
ultimately show False
using race ts_j
by (auto simp add: races_def ins eqs)
next
case Fence
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
next
case (Ghost A' L' R' W')
with ts_i "is" obtain
ins: "ins = Ghost A' L' R' W'" and
A'_owns_shared: "A' ⊆ dom u_shared ∪ 𝒪" and
L'_A': "L' ⊆ A'" and
R'_owned: "R' ⊆ 𝒪" and
A'_R': "A' ∩ R' = {}" and
acq_ok: "∀j<length u_ts. i ≠ j ⟶ A' ∩ ((map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)) = {}"
by auto
from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
obtain 𝒪⇩l_A': "A' ∩ 𝒪⇩l = {}" and ℛ⇩l_A': "A' ∩ dom (ℛ⇩l) = {}"
by auto
from race ts_j
obtain a' where a'_A': "a' ∈ A'" and
a'_aug: "a' ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
by (auto simp add: races_def ins eqs)
show False
proof (cases "a' ∈ R")
case False
with a'_aug a'_A' ℛ⇩l_A' show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns have a'_owns⇩l: "a' ∈ 𝒪⇩l"
by auto
with 𝒪⇩l_A' a'_A' show False
by auto
qed
next
case (RMWReadOnly cond t a D f ret A' L' R' W')
with ts_i "is" obtain
ins: "ins = RMW a t (D, f) cond ret A' L' R' W'" and
owned_or_shared: "a ∈ 𝒪 ∨ a ∈ dom u_shared" and
cond: "¬ cond (θ(t ↦ u_m a))" and
rels_race: "∀j<length (map owned u_ts). i ≠ j ⟶ ((map released u_ts) ! j) a ≠ Some False"
by auto
from dist_u_ts_inter.simple_ownership_distinct [OF j_bound_u i_bound_u neq_j_i u_ts_j [simplified ts⇩l_j]
u_ts_i [simplified ts_i]]
have dist: "𝒪⇩l ∩ 𝒪 = {}"
by auto
from race ts_j cond
have rc: "augment_rels (dom 𝒮⇩l) R ℛ⇩l a = Some False"
by (auto simp add: races_def ins eqs u_m_eq)
from rels_race [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]]
u_ts_j ts⇩l_j j_bound_u
have ℛ⇩l_a: "ℛ⇩l a ≠ Some False"
by auto
show ?thesis
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
from shared_unch [rule_format, OF a_owns⇩l]
have u_shared_eq: "u_shared a = 𝒮⇩l a"
by auto
from a_owns⇩l dist have "a ∉ 𝒪"
by auto
with u_shared_eq rc True ℛ⇩l_a owned_or_shared show False
by (auto simp add: augment_rels_def split: option.splits simp add: domIff)
qed
next
case (RMWWrite cond t a A' L' R' D f ret W')
with ts_i "is" obtain
ins: "ins = RMW a t (D, f) cond ret A' L' R' W'" and
cond: "cond (θ(t ↦ u_m a))" and
a_un_owned_released: "∀j<length (map owned u_ts). i ≠ j ⟶ a ∉ (map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)" and
A'_owns_shared:"A' ⊆ dom u_shared ∪ 𝒪" and
L'_A': "L' ⊆ A'" and
R'_owned: "R' ⊆ 𝒪" and
A'_R': "A' ∩ R' = {}" and
acq_ok: "∀j<length (map owned u_ts). i ≠ j ⟶ A' ∩ ((map owned u_ts) ! j ∪ dom ((map released u_ts) ! j)) = {}" and
writeable: "a ∉ read_only u_shared"
by auto
from a_un_owned_released [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
obtain 𝒪⇩l_a: "a ∉ 𝒪⇩l" and ℛ⇩l_a: "a ∉ dom (ℛ⇩l)"
by auto
from acq_ok [rule_format, simplified, OF j_bound_u neq_j_i [symmetric]] u_ts_j ts⇩l_j j_bound_u
obtain 𝒪⇩l_A': "A' ∩ 𝒪⇩l = {}" and ℛ⇩l_A': "A' ∩ dom (ℛ⇩l) = {}"
by auto
{
assume rc: "a ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
have False
proof (cases "a ∈ R")
case False
with rc ℛ⇩l_a show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns
have a_owns⇩l: "a ∈ 𝒪⇩l"
by auto
with 𝒪⇩l_a show False
by auto
qed
}
moreover
{
assume rc: "A' ∩ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l) ≠ {}"
then obtain a' where a'_A': "a' ∈ A'" and a'_aug: "a' ∈ dom (augment_rels (dom 𝒮⇩l) R ℛ⇩l)"
by auto
have False
proof (cases "a' ∈ R")
case False
with a'_aug a'_A' ℛ⇩l_A' show False
by (auto simp add: augment_rels_def domIff)
next
case True
with R_owns have a'_owns⇩l: "a' ∈ 𝒪⇩l"
by auto
with 𝒪⇩l_A' a'_A' show False
by auto
qed
}
ultimately show False
using race ts_j cond
by (auto simp add: races_def ins eqs u_m_eq)
next
next
case Nil
then show ?thesis
using ts_i ts⇩l_j race "is" j_bound i_bound u_ts_i u_ts_j leq_u_ts neq_j_i ts_j
by (auto simp add:eqs races_def split: if_split_asm)
qed
}
hence "¬ safe_delayed (u_ts, u_m, u_shared)"
apply (clarsimp simp add: safe_delayed_def)
apply (rule_tac x=i in exI)
using u_ts_i ts_i i_bound_u
apply auto
done
moreover
from safe_delayed_c_undo' [rule_format, of n] c_undo_n
have "safe_delayed (u_ts, u_m, u_shared)"
by simp
ultimately have False
by simp
thus ?thesis
by simp
qed
qed
next
case (StoreBuffer _ p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
hence False
by (auto simp add: empty_storebuffer_step_def)
thus ?thesis ..
qed
qed
}
ultimately show ?thesis
using last_action_of_thread [where i=j, OF trace]
by blast
qed
qed
datatype 'p memref =
Write⇩s⇩b bool addr sop val acq lcl rel wrt
| Read⇩s⇩b bool addr tmp val
| Prog⇩s⇩b 'p 'p "instrs"
| Ghost⇩s⇩b acq lcl rel wrt
type_synonym 'p store_buffer = "'p memref list"
inductive flush_step:: "memory × 'p store_buffer × owns × rels × shared ⇒ memory × 'p store_buffer × owns × rels × shared ⇒ bool"
("_ →⇩f _" [60,60] 100)
where
Write⇩s⇩b: "⟦𝒪' = (if volatile then 𝒪 ∪ A - R else 𝒪);
𝒮' = (if volatile then 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L else 𝒮);
ℛ'=(if volatile then Map.empty else ℛ)⟧
⟹
(m, Write⇩s⇩b volatile a sop v A L R W# rs,𝒪,ℛ,𝒮) →⇩f (m(a := v), rs,𝒪',ℛ',𝒮')"
| Read⇩s⇩b: "(m, Read⇩s⇩b volatile a t v#rs,𝒪,ℛ,𝒮) →⇩f (m, rs,𝒪,ℛ, 𝒮)"
| Prog⇩s⇩b: "(m, Prog⇩s⇩b p p' is#rs,𝒪,ℛ, 𝒮) →⇩f (m, rs,𝒪,ℛ, 𝒮)"
| Ghost: "(m, Ghost⇩s⇩b A L R W# rs,𝒪,ℛ,𝒮) →⇩f (m, rs,𝒪 ∪ A - R, augment_rels (dom 𝒮) R ℛ, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L )"
abbreviation flush_steps::"memory × 'p store_buffer × owns × rels × shared ⇒ memory × 'p store_buffer × owns × rels × shared⇒ bool"
("_ →⇩f⇧* _" [60,60] 100)
where
"flush_steps == flush_step^**"
term "x →⇩f⇧* Y"
lemmas flush_step_induct =
flush_step.induct [split_format (complete),
consumes 1, case_names Write⇩s⇩b Read⇩s⇩b Prog⇩s⇩b Ghost]
inductive store_buffer_step:: "memory × 'p store_buffer × 'owns × 'rels × 'shared ⇒ memory × 'p memref list × 'owns × 'rels × 'shared ⇒ bool"
("_ →⇩w _" [60,60] 100)
where
SBWrite⇩s⇩b: "
(m, Write⇩s⇩b volatile a sop v A L R W# rs,𝒪,ℛ,𝒮) →⇩w (m(a := v), rs,𝒪,ℛ,𝒮)"
abbreviation store_buffer_steps::"memory × 'p store_buffer × 'owns × 'rels × 'shared ⇒ memory × 'p store_buffer × 'owns × 'rels × 'shared⇒ bool"
("_ →w⇧* _" [60,60] 100)
where
"store_buffer_steps == store_buffer_step^**"
term "x →w⇧* Y"
fun buffered_val :: "'p memref list ⇒ addr ⇒ val option"
where
"buffered_val [] a = None"
| "buffered_val (r # rs) a' =
(case r of
Write⇩s⇩b volatile a _ v _ _ _ _ ⇒ (case buffered_val rs a' of
None ⇒ (if a'=a then Some v else None)
| Some v' ⇒ Some v')
| _ ⇒ buffered_val rs a')"
definition address_of :: "'p memref ⇒ addr set"
where
"address_of r = (case r of Write⇩s⇩b volatile a _ v _ _ _ _ ⇒ {a} | Read⇩s⇩b volatile a t v ⇒ {a} |
_ ⇒ {})"
lemma address_of_simps [simp]:
"address_of (Write⇩s⇩b volatile a sop v A L R W) = {a}"
"address_of (Read⇩s⇩b volatile a t v) = {a}"
"address_of (Prog⇩s⇩b p p' is) = {}"
"address_of (Ghost⇩s⇩b A L R W) = {}"
by (auto simp add: address_of_def)
definition is_volatile :: "'p memref ⇒ bool"
where
"is_volatile r = (case r of Write⇩s⇩b volatile a _ v _ _ _ _⇒ volatile | Read⇩s⇩b volatile a t v ⇒ volatile
| _ ⇒ False)"
lemma is_volatile_simps [simp]:
"is_volatile (Write⇩s⇩b volatile a sop v A L R W) = volatile"
"is_volatile (Read⇩s⇩b volatile a t v) = volatile"
"is_volatile (Prog⇩s⇩b p p' is) = False"
"is_volatile (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_volatile_def)
definition is_Write⇩s⇩b:: "'p memref ⇒ bool"
where
"is_Write⇩s⇩b r = (case r of Write⇩s⇩b volatile a _ v _ _ _ _⇒ True | _ ⇒ False)"
definition is_Read⇩s⇩b:: "'p memref ⇒ bool"
where
"is_Read⇩s⇩b r = (case r of Read⇩s⇩b volatile a t v ⇒ True | _ ⇒ False)"
definition is_Prog⇩s⇩b:: "'p memref ⇒ bool"
where
"is_Prog⇩s⇩b r = (case r of Prog⇩s⇩b _ _ _ ⇒ True | _ ⇒ False)"
definition is_Ghost⇩s⇩b:: "'p memref ⇒ bool"
where
"is_Ghost⇩s⇩b r = (case r of Ghost⇩s⇩b _ _ _ _ ⇒ True | _ ⇒ False)"
lemma is_Write⇩s⇩b_simps [simp]:
"is_Write⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = True"
"is_Write⇩s⇩b (Read⇩s⇩b volatile a t v) = False"
"is_Write⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_Write⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_Write⇩s⇩b_def)
lemma is_Read⇩s⇩b_simps [simp]:
"is_Read⇩s⇩b (Read⇩s⇩b volatile a t v) = True"
"is_Read⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = False"
"is_Read⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_Read⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_Read⇩s⇩b_def)
lemma is_Prog⇩s⇩b_simps [simp]:
"is_Prog⇩s⇩b (Read⇩s⇩b volatile a t v) = False"
"is_Prog⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = False"
"is_Prog⇩s⇩b (Prog⇩s⇩b p p' is) = True"
"is_Prog⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_Prog⇩s⇩b_def)
lemma is_Ghost⇩s⇩b_simps [simp]:
"is_Ghost⇩s⇩b (Read⇩s⇩b volatile a t v) = False"
"is_Ghost⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = False"
"is_Ghost⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_Ghost⇩s⇩b (Ghost⇩s⇩b A L R W) = True"
by (auto simp add: is_Ghost⇩s⇩b_def)
definition is_volatile_Write⇩s⇩b:: "'p memref ⇒ bool"
where
"is_volatile_Write⇩s⇩b r = (case r of Write⇩s⇩b volatile a _ v _ _ _ _⇒ volatile | _ ⇒ False)"
lemma is_volatile_Write⇩s⇩b_simps [simp]:
"is_volatile_Write⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = volatile"
"is_volatile_Write⇩s⇩b (Read⇩s⇩b volatile a t v) = False"
"is_volatile_Write⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_volatile_Write⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_volatile_Write⇩s⇩b_def)
lemma is_volatile_Write⇩s⇩b_address_of [simp]: "is_volatile_Write⇩s⇩b x ⟹ address_of x ≠ {}"
by (cases x) auto
definition is_volatile_Read⇩s⇩b:: "'p memref ⇒ bool"
where
"is_volatile_Read⇩s⇩b r = (case r of Read⇩s⇩b volatile a t v ⇒ volatile | _ ⇒ False)"
lemma is_volatile_Read⇩s⇩b_simps [simp]:
"is_volatile_Read⇩s⇩b (Read⇩s⇩b volatile a t v) = volatile"
"is_volatile_Read⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = False"
"is_volatile_Read⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_volatile_Read⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_volatile_Read⇩s⇩b_def)
definition is_non_volatile_Write⇩s⇩b:: "'p memref ⇒ bool"
where
"is_non_volatile_Write⇩s⇩b r = (case r of Write⇩s⇩b volatile a _ v _ _ _ _⇒ ¬ volatile | _ ⇒ False)"
lemma is_non_volatile_Write⇩s⇩b_simps [simp]:
"is_non_volatile_Write⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = (¬ volatile)"
"is_non_volatile_Write⇩s⇩b (Read⇩s⇩b volatile a t v) = False"
"is_non_volatile_Write⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_non_volatile_Write⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_non_volatile_Write⇩s⇩b_def)
definition is_non_volatile_Read⇩s⇩b:: "'p memref ⇒ bool"
where
"is_non_volatile_Read⇩s⇩b r = (case r of Read⇩s⇩b volatile a t v ⇒ ¬ volatile | _ ⇒ False)"
lemma is_non_volatile_Read⇩s⇩b_simps [simp]:
"is_non_volatile_Read⇩s⇩b (Read⇩s⇩b volatile a t v) = (¬ volatile)"
"is_non_volatile_Read⇩s⇩b (Write⇩s⇩b volatile a sop v A L R W) = False"
"is_non_volatile_Read⇩s⇩b (Prog⇩s⇩b p p' is) = False"
"is_non_volatile_Read⇩s⇩b (Ghost⇩s⇩b A L R W) = False"
by (auto simp add: is_non_volatile_Read⇩s⇩b_def)
lemma is_volatile_split: "is_volatile r =
(is_volatile_Read⇩s⇩b r ∨ is_volatile_Write⇩s⇩b r)"
by (cases r) auto
lemma is_non_volatile_split:
"¬ is_volatile r = (is_non_volatile_Read⇩s⇩b r ∨ is_non_volatile_Write⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r)"
by (cases r) auto
fun outstanding_refs:: "('p memref ⇒ bool) ⇒ 'p memref list ⇒ addr set"
where
"outstanding_refs P [] = {}"
| "outstanding_refs P (r#rs) = (if P r then (address_of r) ∪ (outstanding_refs P rs)
else outstanding_refs P rs)"
lemma outstanding_refs_conv: "outstanding_refs P sb = ⋃(address_of ` {r. r ∈ set sb ∧ P r})"
by (induct sb) auto
lemma outstanding_refs_append:
"⋀ys. outstanding_refs vol (xs@ys) = outstanding_refs vol xs ∪ outstanding_refs vol ys"
by (auto simp add: outstanding_refs_conv)
lemma outstanding_refs_empty_negate: "(outstanding_refs P sb = {}) ⟹
(outstanding_refs (Not ∘ P) sb = ⋃(address_of ` set sb))"
by (auto simp add: outstanding_refs_conv)
lemma outstanding_refs_mono_pred:
"⋀sb sb'.
∀r. P r ⟶ P' r ⟹ outstanding_refs P sb ⊆ outstanding_refs P' sb"
by (auto simp add: outstanding_refs_conv)
lemma outstanding_refs_mono_set:
"⋀sb sb'.
set sb ⊆ set sb' ⟹ outstanding_refs P sb ⊆ outstanding_refs P sb'"
by (auto simp add: outstanding_refs_conv)
lemma outstanding_refs_takeWhile:
"outstanding_refs P (takeWhile P' sb) ⊆ outstanding_refs P sb"
apply (rule outstanding_refs_mono_set)
apply (auto dest: set_takeWhileD)
done
lemma outstanding_refs_subsets:
"outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb"
"outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb"
"outstanding_refs is_volatile_Read⇩s⇩b sb ⊆ outstanding_refs is_Read⇩s⇩b sb"
"outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ outstanding_refs is_Read⇩s⇩b sb"
"outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile) sb"
"outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile) sb"
"outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ outstanding_refs (is_volatile) sb"
"outstanding_refs is_volatile_Read⇩s⇩b sb ⊆ outstanding_refs (is_volatile) sb"
"outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile_Write⇩s⇩b) sb"
"outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile_Write⇩s⇩b) sb"
"outstanding_refs is_volatile_Read⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile_Write⇩s⇩b) sb"
"outstanding_refs is_Read⇩s⇩b sb ⊆ outstanding_refs (Not ∘ is_volatile_Write⇩s⇩b) sb"
by (auto intro!:outstanding_refs_mono_pred simp add: is_volatile_Write⇩s⇩b_def is_non_volatile_Write⇩s⇩b_def
is_volatile_Read⇩s⇩b_def is_non_volatile_Read⇩s⇩b_def is_Read⇩s⇩b_def split: memref.splits)
lemma outstanding_non_volatile_refs_conv:
"outstanding_refs (Not ∘ is_volatile) sb =
outstanding_refs is_non_volatile_Write⇩s⇩b sb ∪ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a, auto)
done
lemma outstanding_volatile_refs_conv:
"outstanding_refs is_volatile sb =
outstanding_refs is_volatile_Write⇩s⇩b sb ∪ outstanding_refs is_volatile_Read⇩s⇩b sb"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a, auto)
done
lemma outstanding_is_Write⇩s⇩b_refs_conv:
"outstanding_refs is_Write⇩s⇩b sb =
outstanding_refs is_non_volatile_Write⇩s⇩b sb ∪ outstanding_refs is_volatile_Write⇩s⇩b sb"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a, auto)
done
lemma outstanding_is_Read⇩s⇩b_refs_conv:
"outstanding_refs is_Read⇩s⇩b sb =
outstanding_refs is_non_volatile_Read⇩s⇩b sb ∪ outstanding_refs is_volatile_Read⇩s⇩b sb"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a, auto)
done
lemma outstanding_not_volatile_Read⇩s⇩b_refs_conv: "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) sb =
outstanding_refs is_Write⇩s⇩b sb ∪ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
apply (induct sb)
apply (clarsimp)
subgoal for a sb
by (case_tac a, auto)
done
lemmas misc_outstanding_refs_convs = outstanding_non_volatile_refs_conv outstanding_volatile_refs_conv
outstanding_is_Write⇩s⇩b_refs_conv outstanding_is_Read⇩s⇩b_refs_conv outstanding_not_volatile_Read⇩s⇩b_refs_conv
lemma no_outstanding_vol_write_takeWhile_append: "outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹
takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@xs) = sb@(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs)"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemma outstanding_vol_write_takeWhile_append: "outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {} ⟹
takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@xs) = (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemma no_outstanding_vol_write_dropWhile_append: "outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@xs) = (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs)"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemma outstanding_vol_write_dropWhile_append: "outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {} ⟹
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@xs) = (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)@xs"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemmas outstanding_vol_write_take_drop_appends =
no_outstanding_vol_write_takeWhile_append
outstanding_vol_write_takeWhile_append
no_outstanding_vol_write_dropWhile_append
outstanding_vol_write_dropWhile_append
lemma outstanding_refs_is_non_volatile_Write⇩s⇩b_takeWhile_conv:
"outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) =
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply clarsimp
subgoal for a sb
by (case_tac a, auto)
done
lemma dropWhile_not_vol_write_empty:
"outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹ (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = []"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemma takeWhile_not_vol_write_outstanding_refs:
"outstanding_refs is_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = {}"
apply (induct sb)
apply (auto split: if_split_asm)
done
lemma no_volatile_Write⇩s⇩bs_conv: "(outstanding_refs is_volatile_Write⇩s⇩b sb = {}) =
(∀r ∈ set sb. (∀v' sop' a' A L R W. r ≠ Write⇩s⇩b True a' sop' v' A L R W))"
by (force simp add: outstanding_refs_conv is_volatile_Write⇩s⇩b_def split: memref.splits)
lemma no_volatile_Read⇩s⇩bs_conv: "(outstanding_refs is_volatile_Read⇩s⇩b sb = {}) =
(∀r ∈ set sb. (∀v' t' a'. r ≠ Read⇩s⇩b True a' t' v'))"
by (force simp add: outstanding_refs_conv is_volatile_Read⇩s⇩b_def split: memref.splits)
inductive sb_memop_step :: "(instrs × tmps × 'p store_buffer × memory × 'dirty × 'owns × 'rels × 'shared ) ⇒
(instrs × tmps × 'p store_buffer × memory × 'dirty × 'owns × 'rels × 'shared ) ⇒ bool"
("_ →⇩s⇩b _" [60,60] 100)
where
SBReadBuffered:
"⟦buffered_val sb a = Some v⟧
⟹
(Read volatile a t # is,θ, sb, m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ (t↦v), sb, m,𝒟, 𝒪,ℛ, 𝒮)"
| SBReadUnbuffered:
"⟦buffered_val sb a = None⟧
⟹
(Read volatile a t # is, θ, sb, m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ (t↦m a), sb, m,𝒟, 𝒪, ℛ, 𝒮)"
| SBWriteNonVolatile:
"(Write False a (D,f) A L R W#is, θ, sb, m,𝒟,𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ, sb@ [Write⇩s⇩b False a (D,f) (f θ) A L R W], m,𝒟, 𝒪, ℛ, 𝒮)"
| SBWriteVolatile:
"(Write True a (D,f) A L R W# is, θ, sb, m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ, sb@[Write⇩s⇩b True a (D,f) (f θ) A L R W], m,𝒟, 𝒪, ℛ, 𝒮)"
| SBFence:
"(Fence # is, θ, [], m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b (is, θ, [], m,𝒟, 𝒪, ℛ, 𝒮)"
| SBRMWReadOnly:
"⟦¬ cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b (is, θ(t↦m a),[], m,𝒟, 𝒪, ℛ, 𝒮)"
| SBRMWWrite:
"⟦cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ(t↦ret (m a) (f(θ(t↦m a)))),[], m(a:= f(θ(t↦m a))),𝒟, 𝒪, ℛ, 𝒮)"
| SBGhost:
"(Ghost A L R W# is, θ, sb, m,𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b
(is, θ, sb, m,𝒟, 𝒪, ℛ, 𝒮)"
inductive sbh_memop_step :: "
(instrs × tmps × 'p store_buffer × memory × bool × owns × rels × shared ) ⇒
(instrs × tmps × 'p store_buffer × memory × bool × owns × rels × shared ) ⇒ bool"
("_ →⇩s⇩b⇩h _" [60,60] 100)
where
SBHReadBuffered:
"⟦buffered_val sb a = Some v⟧
⟹
(Read volatile a t # is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ (t↦v), sb@[Read⇩s⇩b volatile a t v], m, 𝒟, 𝒪, ℛ, 𝒮)"
| SBHReadUnbuffered:
"⟦buffered_val sb a = None⟧
⟹
(Read volatile a t # is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ (t↦m a), sb@[Read⇩s⇩b volatile a t (m a)], m, 𝒟, 𝒪, ℛ, 𝒮)"
| SBHWriteNonVolatile:
"(Write False a (D,f) A L R W#is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ, sb@ [Write⇩s⇩b False a (D,f) (f θ) A L R W], m, 𝒟, 𝒪, ℛ, 𝒮)"
| SBHWriteVolatile:
"(Write True a (D,f) A L R W# is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ, sb@[Write⇩s⇩b True a (D,f) (f θ) A L R W], m, True, 𝒪, ℛ, 𝒮)"
| SBHFence:
"(Fence # is, θ, [], m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h (is, θ, [], m, False, 𝒪, Map.empty, 𝒮)"
| SBHRMWReadOnly:
"⟦¬ cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h (is, θ(t↦m a),[], m, False, 𝒪, Map.empty, 𝒮)"
| SBHRMWWrite:
"⟦cond (θ(t↦m a))⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ(t↦ret (m a) (f(θ(t↦m a)))),[], m(a:= f(θ(t↦m a))), False, 𝒪 ∪ A - R,Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
| SBHGhost:
"(Ghost A L R W# is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ, sb@[Ghost⇩s⇩b A L R W], m, 𝒟, 𝒪, ℛ, 𝒮)"
interpretation direct: memory_system direct_memop_step id_storebuffer_step .
interpretation sb: memory_system sb_memop_step store_buffer_step .
interpretation sbh: memory_system sbh_memop_step flush_step .
primrec non_volatile_owned_or_read_only:: "bool ⇒ shared ⇒ owns ⇒ 'a memref list ⇒ bool"
where
"non_volatile_owned_or_read_only pending_write 𝒮 𝒪 [] = True"
| "non_volatile_owned_or_read_only pending_write 𝒮 𝒪 (x#xs) =
(case x of
Read⇩s⇩b volatile a t v ⇒
(¬volatile ⟶ pending_write ⟶ (a ∈ 𝒪 ∨ a ∈ read_only 𝒮)) ∧
non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs
| Write⇩s⇩b volatile a sop v A L R W ⇒
(if volatile then non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) xs
else a ∈ 𝒪 ∧ non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs)
| Ghost⇩s⇩b A L R W ⇒ non_volatile_owned_or_read_only pending_write (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) xs
| _ ⇒ non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs)"
primrec acquired :: "bool ⇒ 'a memref list ⇒ addr set ⇒ addr set"
where
"acquired pending_write [] A = (if pending_write then A else {})"
| "acquired pending_write (x#xs) A =
(case x of
Write⇩s⇩b volatile _ _ _ A' L R W⇒
(if volatile then acquired True xs (if pending_write then (A ∪ A' - R) else (A' - R))
else acquired pending_write xs A)
| Ghost⇩s⇩b A' L R W ⇒ acquired pending_write xs (if pending_write then (A ∪ A' - R) else A)
| _ ⇒ acquired pending_write xs A)"
primrec share :: "'a memref list ⇒ shared ⇒ shared"
where
"share [] S = S"
| "share (x#xs) S =
(case x of
Write⇩s⇩b volatile _ _ _ A L R W ⇒ (if volatile then (share xs (S ⊕⇘W⇙ R ⊖⇘A⇙ L)) else share xs S)
| Ghost⇩s⇩b A L R W ⇒ share xs (S ⊕⇘W⇙ R ⊖⇘A⇙ L)
| _ ⇒ share xs S)"
primrec acquired_reads :: "bool ⇒ 'a memref list ⇒ addr set ⇒ addr set"
where
"acquired_reads pending_write [] A = {}"
| "acquired_reads pending_write (x#xs) A =
(case x of
Read⇩s⇩b volatile a t v ⇒ (if pending_write ∧ ¬ volatile ∧ a ∈ A
then insert a (acquired_reads pending_write xs A)
else acquired_reads pending_write xs A)
| Write⇩s⇩b volatile _ _ _ A' L R W ⇒
(if volatile then acquired_reads True xs (if pending_write then (A ∪ A' - R) else (A' - R))
else acquired_reads pending_write xs A)
| Ghost⇩s⇩b A' L R W ⇒ acquired_reads pending_write xs (A ∪ A' - R)
| _ ⇒ acquired_reads pending_write xs A)"
lemma union_mono_aux: "A ⊆ B ⟹ A ∪ C ⊆ B ∪ C"
by blast
lemma set_minus_mono_aux: "A ⊆ B ⟹ A - C ⊆ B - C"
by blast
lemma acquired_mono: "⋀A B pending_write. A ⊆ B ⟹ acquired pending_write xs A ⊆ acquired pending_write xs B"
apply (induct xs)
apply simp
subgoal for a xs A B pending_write
apply (case_tac a )
apply clarsimp
subgoal for volatile a1 D f v A' L R W x
apply (drule_tac C=A' in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply clarsimp
apply clarsimp
apply clarsimp
subgoal for A' L R W x
apply (drule_tac C=A' in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
lemma acquired_mono_in:
assumes x_in: "x ∈ acquired pending_write xs A"
assumes sub: "A ⊆ B"
shows "x ∈ acquired pending_write xs B"
using acquired_mono [OF sub, of pending_write xs] x_in
by blast
lemma acquired_no_pending_write:"⋀A B. acquired False xs A = acquired False xs B"
by (induct xs) (auto split: memref.splits)
lemma acquired_no_pending_write_in:
"x ∈ acquired False xs A ⟹ x ∈ acquired False xs B"
apply (subst acquired_no_pending_write)
apply auto
done
lemma acquired_pending_write_mono_in: "⋀A B. x ∈ acquired False xs A ⟹ x ∈ acquired True xs B"
apply (induct xs)
apply (auto split: memref.splits if_split_asm intro: acquired_mono_in)
done
lemma acquired_pending_write_mono: "acquired False xs A ⊆ acquired True xs B"
by (auto intro: acquired_pending_write_mono_in)
lemma acquired_append: "⋀A pending_write. acquired pending_write (xs@ys) A =
acquired (pending_write ∨ outstanding_refs is_volatile_Write⇩s⇩b xs ≠ {}) ys (acquired pending_write xs A)"
apply (induct xs)
apply (auto split: memref.splits intro: acquired_no_pending_write_in)
done
lemma acquired_take_drop:
"acquired (pending_write ∨ outstanding_refs is_volatile_Write⇩s⇩b (takeWhile P xs) ≠ {})
(dropWhile P xs) (acquired pending_write (takeWhile P xs) A) =
acquired pending_write xs A"
proof -
have "acquired pending_write xs A = acquired pending_write ((takeWhile P xs)@(dropWhile P xs)) A"
by simp
also
from acquired_append [where xs="(takeWhile P xs)" and ys="(dropWhile P xs)"]
have "… = acquired (pending_write ∨ outstanding_refs is_volatile_Write⇩s⇩b (takeWhile P xs) ≠ {})
(dropWhile P xs) (acquired pending_write (takeWhile P xs) A)"
by simp
finally show ?thesis
by simp
qed
lemma share_mono: "⋀A B. dom A ⊆ dom B ⟹ dom (share xs A) ⊆ dom (share xs B)"
apply (induct xs)
apply simp
subgoal for a xs A B
apply (case_tac a)
apply (clarsimp iff del: domIff)
subgoal for volatile a1 D f v A' L R W x
apply (drule_tac C="R" and x="W" in augment_mono_aux)
apply (drule_tac C="L" in restrict_mono_aux)
apply blast
done
apply clarsimp
apply clarsimp
apply (clarsimp iff del: domIff)
subgoal for A' L R W x
apply (drule_tac C="R" and x="W" in augment_mono_aux)
apply (drule_tac C="L" in restrict_mono_aux)
apply blast
done
done
done
lemma share_mono_in:
assumes x_in: "x ∈ dom (share xs A)"
assumes sub: "dom A ⊆ dom B"
shows "x ∈ dom (share xs B)"
using share_mono [OF sub, of xs] x_in
by blast
lemma acquired_reads_mono:
"⋀A B pending_write. A ⊆ B ⟹ acquired_reads pending_write xs A ⊆ acquired_reads pending_write xs B"
apply (induct xs)
apply simp
subgoal for a xs A B pending_write
apply (case_tac a)
apply clarsimp
subgoal for volatile a1 D f v A' L R W x
apply (drule_tac C="A'" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply clarsimp
apply blast
apply clarsimp
apply clarsimp
subgoal for A' L R W x
apply (drule_tac C="A'" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
lemma acquired_reads_mono_in:
assumes x_in: "x ∈ acquired_reads pending_write xs A"
assumes sub: "A ⊆ B"
shows "x ∈ acquired_reads pending_write xs B"
using acquired_reads_mono [OF sub, of pending_write xs] x_in
by blast
lemma acquired_reads_no_pending_write: "⋀A B. acquired_reads False xs A = acquired_reads False xs B"
by (induct xs) (auto split: memref.splits)
lemma acquired_reads_no_pending_write_in:
"x ∈ acquired_reads False xs A ⟹ x ∈ acquired_reads False xs B"
apply (subst acquired_reads_no_pending_write)
apply blast
done
lemma acquired_reads_pending_write_mono:
"⋀A. acquired_reads False xs A ⊆ acquired_reads True xs A"
by (induct xs) (auto split: memref.splits intro: acquired_reads_mono_in )
lemma acquired_reads_pending_write_mono_in:
assumes x_in: "x ∈ acquired_reads False xs A"
shows "x ∈ acquired_reads True xs A"
using acquired_reads_pending_write_mono [of xs A] x_in
by blast
lemma acquired_reads_append: "⋀pending_write A. acquired_reads pending_write (xs@ys) A =
acquired_reads pending_write xs A ∪
acquired_reads (pending_write ∨ (outstanding_refs is_volatile_Write⇩s⇩b xs ≠ {})) ys
(acquired pending_write xs A)"
proof (induct xs)
case Nil thus ?case by (auto dest: acquired_reads_no_pending_write_in)
next
case (Cons x xs)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
show ?thesis
using Cons.hyps
by (auto simp add: Write⇩s⇩b False)
next
case True
show ?thesis
using Cons.hyps
by (auto simp add: Write⇩s⇩b True)
qed
next
case (Read⇩s⇩b volatile a t v)
show ?thesis
proof (cases volatile)
case False
show ?thesis
using Cons.hyps
by (auto simp add: Read⇩s⇩b False)
next
case True
show ?thesis
using Cons.hyps
by (auto simp add: Read⇩s⇩b True)
qed
next
case Prog⇩s⇩b
with Cons.hyps show ?thesis by auto
next
case (Ghost⇩s⇩b A' L R W)
have "(acquired False xs (A ∪ A' -R )) = (acquired False xs A)"
by (simp add: acquired_no_pending_write)
with Cons.hyps show ?thesis by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma in_acquired_reads_no_pending_write_outstanding_write:
"⋀A. a ∈ acquired_reads False xs A ⟹ outstanding_refs (is_volatile_Write⇩s⇩b) xs ≠ {}"
apply (induct xs)
apply simp
apply (auto split: memref.splits)
apply auto
done
lemma augment_read_only_mono: "read_only 𝒮 ⊆ read_only 𝒮' ⟹
read_only (𝒮 ⊕⇘W⇙ R) ⊆ read_only (𝒮' ⊕⇘W⇙ R)"
by (auto simp add: augment_shared_def read_only_def)
lemma restrict_read_only_mono: "read_only 𝒮 ⊆ read_only 𝒮' ⟹
read_only (𝒮 ⊖⇘A⇙ L) ⊆ read_only (𝒮' ⊖⇘A⇙ L)"
apply (clarsimp simp add: restrict_shared_def read_only_def split: option.splits if_split_asm)
apply (rule conjI)
apply blast
apply fastforce
done
lemma share_read_only_mono: "⋀𝒮 𝒮'. read_only 𝒮 ⊆ read_only 𝒮' ⟹
read_only (share sb 𝒮) ⊆ read_only (share sb 𝒮')"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
note ‹read_only 𝒮 ⊆ read_only 𝒮'›
from augment_read_only_mono [OF this]
have "read_only (𝒮 ⊕⇘W⇙ R) ⊆ read_only (𝒮' ⊕⇘W⇙ R)".
from restrict_read_only_mono [OF this, of A L]
have "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from Cons.hyps [OF this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
note ‹read_only 𝒮 ⊆ read_only 𝒮'›
from augment_read_only_mono [OF this]
have "read_only (𝒮 ⊕⇘W⇙ R) ⊆ read_only (𝒮' ⊕⇘W⇙ R)".
from restrict_read_only_mono [OF this, of A L]
have "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from Cons.hyps [OF this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma non_volatile_owned_or_read_only_append:
"⋀𝒪 𝒮 pending_write. non_volatile_owned_or_read_only pending_write 𝒮 𝒪 (xs@ys)
= (non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs ∧
non_volatile_owned_or_read_only (pending_write ∨ outstanding_refs is_volatile_Write⇩s⇩b xs ≠ {})
(share xs 𝒮) (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma non_volatile_owned_or_read_only_mono:
"⋀𝒪 𝒪' 𝒮 pending_write. 𝒪 ⊆ 𝒪' ⟹ non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs
⟹ non_volatile_owned_or_read_only pending_write 𝒮 𝒪' xs"
apply (induct xs)
apply simp
subgoal for a xs 𝒪 𝒪' 𝒮 pending_write
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a1 D f v A L R W
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply fastforce
apply fastforce
apply fastforce
apply clarsimp
subgoal for A L R W
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
lemma non_volatile_owned_or_read_only_shared_mono:
"⋀𝒮 𝒮' 𝒪 pending_write. 𝒮 ⊆⇩s 𝒮' ⟹ non_volatile_owned_or_read_only pending_write 𝒮 𝒪 xs
⟹ non_volatile_owned_or_read_only pending_write 𝒮' 𝒪 xs"
apply (induct xs)
apply simp
subgoal for a xs 𝒮 𝒮' 𝒪 pending_write
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a1 D f v A L R W
apply (frule_tac C="R" and x="W" in augment_mono_map)
apply (drule_tac A="𝒮 ⊕⇘W⇙ R" and C="L" in restrict_mono_map)
apply (fastforce dest: read_only_mono)
done
apply (fastforce dest: read_only_mono shared_leD)
apply fastforce
subgoal for A L R W
apply (frule_tac C="R" and x="W" in augment_mono_map)
apply (drule_tac A="𝒮 ⊕⇘W⇙ R" and C="L" in restrict_mono_map)
apply (fastforce dest: read_only_mono)
done
done
done
lemma non_volatile_owned_or_read_only_pending_write_antimono:
"⋀𝒪 𝒮. non_volatile_owned_or_read_only True 𝒮 𝒪 xs
⟹ non_volatile_owned_or_read_only False 𝒮 𝒪 xs"
by (induct xs) (auto split: memref.splits)
primrec all_acquired :: "'a memref list ⇒ addr set"
where
"all_acquired [] = {}"
| "all_acquired (i#is) =
(case i of
Write⇩s⇩b volatile _ _ _ A L R W ⇒ (if volatile then A ∪ all_acquired is else all_acquired is)
| Ghost⇩s⇩b A L R W ⇒ A ∪ all_acquired is
| _ ⇒ all_acquired is)"
lemma all_acquired_append: "all_acquired (xs@ys) = all_acquired xs ∪ all_acquired ys"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma acquired_reads_all_acquired: "⋀𝒪 pending_write.
acquired_reads pending_write sb 𝒪 ⊆ 𝒪 ∪ all_acquired sb"
apply (induct sb)
apply clarsimp
apply (auto split: memref.splits)
done
lemma acquired_takeWhile_non_volatile_Write⇩s⇩b:
"⋀A. (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) A) ⊆
A ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply clarsimp
subgoal for a sb A
apply (case_tac a)
apply auto
done
done
lemma acquired_False_takeWhile_non_volatile_Write⇩s⇩b:
"acquired False (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) A = {}"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a) auto
done
lemma outstanding_refs_takeWhile_opposite: "outstanding_refs P (takeWhile (Not ∘ P) xs) = {}"
apply (induct xs)
apply auto
done
lemma no_outstanding_volatile_Write⇩s⇩b_acquired:
"outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹ acquired False sb A = {}"
apply (induct sb)
apply simp
subgoal for a sb
by (case_tac a) auto
done
lemma acquired_all_acquired:"⋀pending_write A. acquired pending_write xs A ⊆ A ∪ all_acquired xs"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma acquired_all_acquired_in: "x ∈ acquired pending_write xs A ⟹ x ∈ A ∪ all_acquired xs"
using acquired_all_acquired
by blast
primrec sharing_consistent:: "shared ⇒ owns ⇒ 'a memref list ⇒ bool"
where
"sharing_consistent 𝒮 𝒪 [] = True"
| "sharing_consistent 𝒮 𝒪 (r#rs) =
(case r of
Write⇩s⇩b volatile _ _ _ A L R W ⇒
(if volatile then A ⊆ dom 𝒮 ∪ 𝒪 ∧ L ⊆ A ∧ A ∩ R = {} ∧ R ⊆ 𝒪 ∧
sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) rs
else sharing_consistent 𝒮 𝒪 rs)
| Ghost⇩s⇩b A L R W ⇒ A ⊆ dom 𝒮 ∪ 𝒪 ∧ L ⊆ A ∧ A ∩ R = {} ∧ R ⊆ 𝒪 ∧
sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) rs
| _ ⇒ sharing_consistent 𝒮 𝒪 rs)"
lemma sharing_consistent_all_acquired:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ all_acquired sb ⊆ dom 𝒮 ∪ 𝒪"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems show ?thesis by auto
qed
qed
lemma sharing_consistent_append:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 (xs@ys) =
(sharing_consistent 𝒮 𝒪 xs ∧
sharing_consistent (share xs 𝒮) (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done
primrec read_only_reads :: "owns ⇒ 'a memref list ⇒ addr set"
where
"read_only_reads 𝒪 [] = {}"
| "read_only_reads 𝒪 (x#xs) =
(case x of
Read⇩s⇩b volatile a t v ⇒ (if ¬ volatile ∧ a ∉ 𝒪
then insert a (read_only_reads 𝒪 xs)
else read_only_reads 𝒪 xs)
| Write⇩s⇩b volatile _ _ _ A L R W ⇒
(if volatile then read_only_reads (𝒪 ∪ A - R) xs
else read_only_reads 𝒪 xs )
| Ghost⇩s⇩b A L R W ⇒ read_only_reads (𝒪 ∪ A - R) xs
| _ ⇒ read_only_reads 𝒪 xs)"
lemma read_only_reads_append:
"⋀𝒪. read_only_reads 𝒪 (xs@ys) =
read_only_reads 𝒪 xs ∪ read_only_reads (acquired True xs 𝒪) ys"
apply (induct xs)
apply simp
subgoal for a xs 𝒪
by (case_tac a) auto
done
lemma read_only_reads_antimono:
"⋀𝒪 𝒪'.
𝒪 ⊆ 𝒪' ⟹ read_only_reads 𝒪' sb ⊆ read_only_reads 𝒪 sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒪 𝒪'
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a1 D f v A L R W
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply auto
subgoal for A L R W x
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
primrec non_volatile_writes_unshared:: "shared ⇒ 'a memref list ⇒ bool"
where
"non_volatile_writes_unshared 𝒮 [] = True"
| "non_volatile_writes_unshared 𝒮 (x#xs) =
(case x of
Write⇩s⇩b volatile a sop v A L R W ⇒ (if volatile then non_volatile_writes_unshared (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) xs
else a ∉ dom 𝒮 ∧ non_volatile_writes_unshared 𝒮 xs)
| Ghost⇩s⇩b A L R W ⇒ non_volatile_writes_unshared (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) xs
| _ ⇒ non_volatile_writes_unshared 𝒮 xs)"
lemma non_volatile_writes_unshared_append:
"⋀𝒮. non_volatile_writes_unshared 𝒮 (xs@ys)
= (non_volatile_writes_unshared 𝒮 xs ∧ non_volatile_writes_unshared (share xs 𝒮) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma non_volatile_writes_unshared_antimono:
"⋀𝒮 𝒮'. dom 𝒮 ⊆ dom 𝒮' ⟹ non_volatile_writes_unshared 𝒮' xs
⟹ non_volatile_writes_unshared 𝒮 xs"
apply (induct xs)
apply simp
subgoal for a xs 𝒮 𝒮'
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a1 D f v A L R W
apply (drule_tac C="R" in augment_mono_aux)
apply (drule_tac C="L" in restrict_mono_aux)
apply blast
done
apply fastforce
apply fastforce
apply fastforce
apply (clarsimp split: if_split_asm)
subgoal for A L R W
apply (drule_tac C="R" in augment_mono_aux)
apply (drule_tac C="L" in restrict_mono_aux)
apply blast
done
done
done
primrec no_write_to_read_only_memory:: "shared ⇒ 'a memref list ⇒ bool"
where
"no_write_to_read_only_memory 𝒮 [] = True"
| "no_write_to_read_only_memory 𝒮 (x#xs) =
(case x of
Write⇩s⇩b volatile a sop v A L R W ⇒ a ∉ read_only 𝒮 ∧
(if volatile then no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) xs
else no_write_to_read_only_memory 𝒮 xs)
| Ghost⇩s⇩b A L R W ⇒ no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) xs
| _ ⇒ no_write_to_read_only_memory 𝒮 xs)"
lemma no_write_to_read_only_memory_append:
"⋀𝒮. no_write_to_read_only_memory 𝒮 (xs@ys)
= (no_write_to_read_only_memory 𝒮 xs ∧ no_write_to_read_only_memory (share xs 𝒮) ys)"
apply (induct xs)
apply simp
subgoal for a xs 𝒮
by (case_tac a) auto
done
lemma no_write_to_read_only_memory_antimono:
"⋀𝒮 𝒮'. 𝒮 ⊆⇩s 𝒮' ⟹ no_write_to_read_only_memory 𝒮' xs
⟹ no_write_to_read_only_memory 𝒮 xs"
apply (induct xs)
apply simp
subgoal for a xs 𝒮 𝒮'
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a1 D f v A L R W
apply (frule_tac C="R" and x="W" in augment_mono_map)
apply (drule_tac A="𝒮 ⊕⇘W⇙ R" and C="L" and x="A" in restrict_mono_map)
apply (fastforce dest: read_only_mono shared_leD)
done
apply (fastforce dest: read_only_mono shared_leD)
apply fastforce
apply fastforce
apply (clarsimp)
subgoal for A L R W
apply (frule_tac C="R" and x="W" in augment_mono_map)
apply (drule_tac A="𝒮 ⊕⇘W⇙ R" and C="L" and x="A" in restrict_mono_map)
apply (fastforce dest: read_only_mono shared_leD)
done
done
done
locale outstanding_non_volatile_refs_owned_or_read_only =
fixes 𝒮::shared
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_non_volatile_refs_owned_or_read_only:
"⋀i is 𝒪 ℛ 𝒟 θ sb p.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
non_volatile_owned_or_read_only False 𝒮 𝒪 sb"
locale outstanding_volatile_writes_unowned_by_others =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_volatile_writes_unowned_by_others:
"⋀i p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j.
⟦i < length ts; j < length ts; i≠j;
ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i); ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)
⟧
⟹
(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i = {}"
locale read_only_reads_unowned =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes read_only_reads_unowned:
"⋀i p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j.
⟦i < length ts; j < length ts; i≠j;
ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i); ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)
⟧
⟹
(𝒪⇩j ∪ all_acquired sb⇩j) ∩
read_only_reads (acquired True
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) 𝒪⇩i)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) = {}"
locale ownership_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes ownership_distinct:
"⋀i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j.
⟦i < length ts; j < length ts; i ≠ j;
ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i); ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)
⟧ ⟹ (𝒪⇩i ∪ all_acquired sb⇩i) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
locale valid_ownership =
outstanding_non_volatile_refs_owned_or_read_only +
outstanding_volatile_writes_unowned_by_others +
read_only_reads_unowned +
ownership_distinct
locale outstanding_non_volatile_writes_unshared =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes outstanding_non_volatile_writes_unshared:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
non_volatile_writes_unshared 𝒮 sb"
locale sharing_consis =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes sharing_consis:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
sharing_consistent 𝒮 𝒪 sb"
locale no_outstanding_write_to_read_only_memory =
fixes 𝒮::shared and ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes no_outstanding_write_to_read_only_memory:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
no_write_to_read_only_memory 𝒮 sb"
locale valid_sharing =
outstanding_non_volatile_writes_unshared +
sharing_consis +
read_only_unowned +
unowned_shared +
no_outstanding_write_to_read_only_memory
locale valid_ownership_and_sharing = valid_ownership +
outstanding_non_volatile_writes_unshared +
sharing_consis +
no_outstanding_write_to_read_only_memory
lemma (in read_only_reads_unowned)
read_only_reads_unowned_nth_update:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') 𝒪')
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb);
𝒪' ∪ all_acquired sb' ⊆ 𝒪 ∪ all_acquired sb⟧ ⟹
read_only_reads_unowned (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
apply (unfold_locales)
apply (clarsimp simp add: nth_list_update split: if_split_asm)
apply (fastforce dest: read_only_reads_unowned)+
done
lemma outstanding_non_volatile_refs_owned_or_read_only_tl:
"outstanding_non_volatile_refs_owned_or_read_only 𝒮 (t#ts) ⟹ outstanding_non_volatile_refs_owned_or_read_only 𝒮 ts"
by (force simp add: outstanding_non_volatile_refs_owned_or_read_only_def)
lemma outstanding_volatile_writes_unowned_by_others_tl:
"outstanding_volatile_writes_unowned_by_others (t#ts) ⟹ outstanding_volatile_writes_unowned_by_others ts"
apply (clarsimp simp add: outstanding_volatile_writes_unowned_by_others_def)
apply fastforce
done
lemma read_only_reads_unowned_tl:
"read_only_reads_unowned (t # ts) ⟹
read_only_reads_unowned (ts)"
apply (clarsimp simp add: read_only_reads_unowned_def)
apply fastforce
done
lemma ownership_distinct_tl:
assumes dist: "ownership_distinct (t#ts)"
shows "ownership_distinct ts"
proof -
from dist
interpret ownership_distinct "t#ts" .
show ?thesis
proof (rule ownership_distinct.intro)
fix i j p "is" 𝒪 ℛ 𝒟 xs sb p' is' 𝒪' ℛ' 𝒟' xs' sb'
assume i_bound: "i < length ts"
and j_bound: "j < length ts"
and neq: "i ≠ j"
and ith: "ts ! i = (p,is,xs,sb,𝒟,𝒪,ℛ)"
and jth: "ts ! j = (p',is', xs', sb',𝒟', 𝒪',ℛ')"
from i_bound j_bound neq ith jth
show "(𝒪 ∪ all_acquired sb) ∩ (𝒪' ∪ all_acquired sb') = {}"
by - (rule ownership_distinct [of "Suc i" "Suc j"],auto)
qed
qed
lemma valid_ownership_tl: "valid_ownership 𝒮 (t#ts) ⟹ valid_ownership 𝒮 ts"
by (auto simp add: valid_ownership_def
intro: outstanding_volatile_writes_unowned_by_others_tl
outstanding_non_volatile_refs_owned_or_read_only_tl ownership_distinct_tl
read_only_reads_unowned_tl)
lemma sharing_consistent_takeWhile:
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "sharing_consistent 𝒮 𝒪 (takeWhile P sb)"
proof -
from consis have "sharing_consistent 𝒮 𝒪 (takeWhile P sb @ dropWhile P sb)"
by simp
with sharing_consistent_append [of _ _ "takeWhile P sb" "dropWhile P sb"]
show ?thesis
by simp
qed
lemma sharing_consis_tl: "sharing_consis 𝒮 (t#ts) ⟹ sharing_consis 𝒮 ts"
by (auto simp add: sharing_consis_def)
lemma sharing_consis_Cons:
"⟦sharing_consis 𝒮 ts; sharing_consistent 𝒮 𝒪 sb⟧
⟹ sharing_consis 𝒮 ((p,is,θ,sb,𝒟,𝒪,ℛ)#ts)"
apply (clarsimp simp add: sharing_consis_def)
subgoal for i pa isa 𝒪' ℛ' 𝒟' θ' sba
by (case_tac i) auto
done
lemma outstanding_non_volatile_writes_unshared_tl:
"outstanding_non_volatile_writes_unshared 𝒮 (t#ts) ⟹
outstanding_non_volatile_writes_unshared 𝒮 ts"
by (auto simp add: outstanding_non_volatile_writes_unshared_def)
lemma no_outstanding_write_to_read_only_memory_tl:
"no_outstanding_write_to_read_only_memory 𝒮 (t#ts) ⟹
no_outstanding_write_to_read_only_memory 𝒮 ts"
by (auto simp add: no_outstanding_write_to_read_only_memory_def)
lemma valid_ownership_and_sharing_tl:
"valid_ownership_and_sharing 𝒮 (t#ts) ⟹ valid_ownership_and_sharing 𝒮 ts"
apply (clarsimp simp add: valid_ownership_and_sharing_def)
apply (auto intro: valid_ownership_tl
outstanding_non_volatile_writes_unshared_tl
no_outstanding_write_to_read_only_memory_tl
sharing_consis_tl)
done
lemma non_volatile_owned_or_read_only_outstanding_non_volatile_writes:
"⋀𝒪 𝒮 pending_write. ⟦non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb⟧
⟹
outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.hyps [of True "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of pending_write "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma (in outstanding_non_volatile_refs_owned_or_read_only) outstanding_non_volatile_writes_owned:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
shows "outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
using non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts_i]]
by blast
lemma non_volatile_reads_acquired_or_read_only:
"⋀𝒪 𝒮. ⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb⟧
⟹
outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb ∪ read_only 𝒮"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True )
from Cons.hyps [OF non_vol consis']
have hyp: "outstanding_refs is_non_volatile_Read⇩s⇩b sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
with R_owns A_R L_A
show ?thesis
apply (clarsimp simp add: Write⇩s⇩b True )
apply (drule (1) rev_subsetD)
apply (auto simp add: in_read_only_convs split: if_split_asm)
done
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b )
from Cons.hyps [OF non_vol consis']
have hyp: "outstanding_refs is_non_volatile_Read⇩s⇩b sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
with R_owns A_R L_A
show ?thesis
apply (clarsimp simp add: Ghost⇩s⇩b )
apply (drule (1) rev_subsetD)
apply (auto simp add: in_read_only_convs split: if_split_asm)
done
qed
qed
lemma non_volatile_reads_acquired_or_read_only_reads:
"⋀𝒪 𝒮 pending_write. ⟦non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb⟧
⟹
outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb ∪ read_only_reads 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True )
from Cons.hyps [OF non_vol ]
have hyp: "outstanding_refs is_non_volatile_Read⇩s⇩b sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only_reads (𝒪 ∪ A - R) sb".
then
show ?thesis
by (auto simp add: Write⇩s⇩b True )
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only pending_write (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b )
from Cons.hyps [OF non_vol ]
have hyp: "outstanding_refs is_non_volatile_Read⇩s⇩b sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only_reads (𝒪 ∪ A - R) sb".
then
show ?thesis
by (auto simp add: Ghost⇩s⇩b )
qed
qed
lemma non_volatile_owned_or_read_only_outstanding_refs:
"⋀𝒪 𝒮 pending_write. ⟦non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb⟧
⟹
outstanding_refs (Not ∘ is_volatile) sb ⊆ 𝒪 ∪ all_acquired sb ∪ read_only_reads 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.hyps [of True "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of pending_write "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma no_unacquired_write_to_read_only:
"⋀𝒮 𝒪. ⟦no_write_to_read_only_memory 𝒮 sb;sharing_consistent 𝒮 𝒪 sb;
a ∈ read_only 𝒮; a ∉ (𝒪 ∪ all_acquired sb)⟧
⟹ a ∉ outstanding_refs is_Write⇩s⇩b sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_ro: "a ∈ read_only 𝒮" and
a_A: "a ∉ A" and a_all_acq: "a ∉ all_acquired sb" and a_owns: "a ∉ 𝒪" and
a'_notin: "a' ∉ read_only 𝒮"
by ( simp add: Write⇩s⇩b True )
from a'_notin a_ro have neq_a_a': "a≠a'"
by blast
from a_A a_all_acq a_owns
have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from a_ro L_A a_A R_owns a_owns
have "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
from Cons.hyps [OF no_wrt consis' this a_notin']
have "a ∉ outstanding_refs is_Write⇩s⇩b sb".
with neq_a_a'
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons
show ?thesis
by (auto)
next
case Prog⇩s⇩b with Cons
show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_ro: "a ∈ read_only 𝒮" and
a_A: "a ∉ A" and a_all_acq: "a ∉ all_acquired sb" and a_owns: "a ∉ 𝒪"
by ( simp add: Ghost⇩s⇩b )
from a_A a_all_acq a_owns
have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from a_ro L_A a_A R_owns a_owns
have "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
from Cons.hyps [OF no_wrt consis' this a_notin']
have "a ∉ outstanding_refs is_Write⇩s⇩b sb".
then
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma read_only_reads_read_only:
"⋀𝒮 𝒪. ⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
sharing_consistent 𝒮 𝒪 sb⟧
⟹
read_only_reads 𝒪 sb ⊆ 𝒪 ∪ all_acquired sb ∪ read_only 𝒮"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True )
from Cons.hyps [OF non_vol consis']
have hyp: "read_only_reads (𝒪 ∪ A - R) sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
{
fix a'
assume a'_in: "a' ∈ read_only_reads (𝒪 ∪ A - R) sb"
assume a'_unowned: "a' ∉ 𝒪"
assume a'_unacq: "a' ∉ all_acquired sb"
assume a'_A: "a' ∉ A"
have "a' ∈ read_only 𝒮"
proof -
from a'_in hyp a'_unowned a'_unacq a'_A
have "a' ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
with L_A R_owns a'_unowned
show ?thesis
by (auto simp add: in_read_only_convs split:if_split_asm)
qed
}
then
show ?thesis
apply (clarsimp simp add: Write⇩s⇩b True simp del: o_apply)
apply force
done
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b )
from Cons.hyps [OF non_vol consis']
have hyp: "read_only_reads (𝒪 ∪ A - R) sb
⊆ 𝒪 ∪ A - R ∪ all_acquired sb ∪ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
{
fix a'
assume a'_in: "a' ∈ read_only_reads (𝒪 ∪ A - R) sb"
assume a'_unowned: "a' ∉ 𝒪"
assume a'_unacq: "a' ∉ all_acquired sb"
assume a'_A: "a' ∉ A"
have "a' ∈ read_only 𝒮"
proof -
from a'_in hyp a'_unowned a'_unacq a'_A
have "a' ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
with L_A R_owns a'_unowned
show ?thesis
by (auto simp add: in_read_only_convs split:if_split_asm)
qed
}
then
show ?thesis
apply (clarsimp simp add: Ghost⇩s⇩b simp del: o_apply)
apply force
done
qed
qed
lemma no_unacquired_write_to_read_only_reads:
"⋀𝒮 𝒪 . ⟦no_write_to_read_only_memory 𝒮 sb;
non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
a ∈ read_only_reads 𝒪 sb; a ∉ (𝒪 ∪ all_acquired sb)⟧
⟹ a ∉ outstanding_refs is_Write⇩s⇩b sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_ro: "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
a_A: "a ∉ A" and a_all_acq: "a ∉ all_acquired sb" and a_owns: "a ∉ 𝒪" and
a'_notin: "a' ∉ read_only 𝒮"
by ( simp add: Write⇩s⇩b True )
from read_only_reads_read_only [OF non_vol consis' ] a_ro a_owns a_all_acq a_A
have "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
with a'_notin R_owns a_owns have neq_a_a': "a≠a'"
by (auto simp add: in_read_only_convs split: if_split_asm)
from a_A a_all_acq a_owns
have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from Cons.hyps [OF no_wrt non_vol consis' a_ro a_notin']
have "a ∉ outstanding_refs is_Write⇩s⇩b sb".
then
show ?thesis
using neq_a_a'
by (auto simp add: Write⇩s⇩b True)
next
case False with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case (Read⇩s⇩b volatile a' t v)
show ?thesis
proof (cases volatile)
case True
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case False
note non_volatile = this
from Cons.prems obtain no_wrt': "no_write_to_read_only_memory 𝒮 sb" and
consis':"sharing_consistent 𝒮 𝒪 sb" and
a_in: "a ∈ (if a' ∉ 𝒪 then insert a' (read_only_reads 𝒪 sb)
else read_only_reads 𝒪 sb)" and
a'_owns_shared: "a' ∈ 𝒪 ∨ a' ∈ read_only 𝒮" and
non_vol': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_owns: "a ∉ 𝒪 ∪ all_acquired sb"
by (clarsimp simp add: Read⇩s⇩b False)
show ?thesis
proof (cases "a' ∈ 𝒪")
case True
with a_in have "a ∈ read_only_reads 𝒪 sb"
by auto
from Cons.hyps [OF no_wrt' non_vol' consis' this a_owns]
show ?thesis
by (clarsimp simp add: Read⇩s⇩b)
next
case False
note a'_unowned = this
with a_in have a_in': "a ∈ insert a' (read_only_reads 𝒪 sb)" by auto
from a'_owns_shared False have a'_read_only: "a' ∈ read_only 𝒮" by auto
show ?thesis
proof (cases "a=a'")
case False
with a_in' have "a ∈ (read_only_reads 𝒪 sb)" by auto
from Cons.hyps [OF no_wrt' non_vol' consis' this a_owns]
show ?thesis
by (simp add: Read⇩s⇩b)
next
case True
from no_unacquired_write_to_read_only [OF no_wrt' consis' a'_read_only] a_owns True
have "a' ∉ outstanding_refs is_Write⇩s⇩b sb"
by auto
then show ?thesis
by (simp add: Read⇩s⇩b True)
qed
qed
qed
next
case Prog⇩s⇩b with Cons
show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain no_wrt: "no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
non_vol: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_ro: "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
a_A: "a ∉ A" and a_all_acq: "a ∉ all_acquired sb" and a_owns: "a ∉ 𝒪"
by ( simp add: Ghost⇩s⇩b )
from read_only_reads_read_only [OF non_vol consis' ] a_ro a_owns a_all_acq a_A
have "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from a_A a_all_acq a_owns
have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from Cons.hyps [OF no_wrt non_vol consis' a_ro a_notin']
have "a ∉ outstanding_refs is_Write⇩s⇩b sb".
then
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma no_unacquired_write_to_read_only'':
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only 𝒮 ∩ outstanding_refs is_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
using no_unacquired_write_to_read_only [OF no_wrt consis]
by auto
lemma no_unacquired_volatile_write_to_read_only:
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only 𝒮 ∩ outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
proof -
have "outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb"
apply (rule outstanding_refs_mono_pred)
apply (auto simp add: is_volatile_Write⇩s⇩b_def split: memref.splits)
done
with no_unacquired_write_to_read_only'' [OF no_wrt consis]
show ?thesis by blast
qed
lemma no_unacquired_non_volatile_write_to_read_only_reads:
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only 𝒮 ∩ outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
proof -
from outstanding_refs_subsets
have "outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb" by - assumption
with no_unacquired_write_to_read_only'' [OF no_wrt consis]
show ?thesis by blast
qed
lemma no_unacquired_write_to_read_only_reads':
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only_reads 𝒪 sb ∩ outstanding_refs is_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
using no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
by auto
lemma no_unacquired_volatile_write_to_read_only_reads:
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only_reads 𝒪 sb ∩ outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
proof -
have "outstanding_refs is_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb"
apply (rule outstanding_refs_mono_pred)
apply (auto simp add: is_volatile_Write⇩s⇩b_def split: memref.splits)
done
with no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
show ?thesis by blast
qed
lemma no_unacquired_non_volatile_write_to_read_only:
assumes no_wrt: "no_write_to_read_only_memory 𝒮 sb"
assumes non_vol: "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "read_only_reads 𝒪 sb ∩ outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ 𝒪 ∪ all_acquired sb"
proof -
from outstanding_refs_subsets
have "outstanding_refs is_non_volatile_Write⇩s⇩b sb ⊆ outstanding_refs is_Write⇩s⇩b sb" by - assumption
with no_unacquired_write_to_read_only_reads [OF no_wrt non_vol consis]
show ?thesis by blast
qed
lemma set_dropWhileD: "x ∈ set (dropWhile P xs) ⟹ x ∈ set xs"
by (induct xs) (auto split: if_split_asm)
lemma outstanding_refs_takeWhileD:
"x ∈ outstanding_refs P (takeWhile P' sb) ⟹ x ∈ outstanding_refs P sb"
using outstanding_refs_takeWhile
by blast
lemma outstanding_refs_dropWhileD:
"x ∈ outstanding_refs P (dropWhile P' sb) ⟹ x ∈ outstanding_refs P sb"
by (auto dest: set_dropWhileD simp add: outstanding_refs_conv)
lemma dropWhile_ConsD: "dropWhile P xs = y#ys ⟹ ¬ P y"
by (simp add: dropWhile_eq_Cons_conv)
lemma non_volatile_owned_or_read_only_drop:
"non_volatile_owned_or_read_only False 𝒮 𝒪 sb
⟹ non_volatile_owned_or_read_only True
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
using non_volatile_owned_or_read_only_append [of False 𝒮 𝒪 "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"]
apply (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty)
apply(clarsimp simp add: outstanding_vol_write_take_drop_appends
takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty )
apply (case_tac "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)")
apply (fastforce simp add: outstanding_refs_conv)
apply (frule dropWhile_ConsD)
apply (clarsimp split: memref.splits)
done
lemma read_only_share: "⋀𝒮 𝒪.
sharing_consistent 𝒮 𝒪 sb ⟹
read_only (share sb 𝒮) ⊆ read_only 𝒮 ∪ 𝒪 ∪ all_acquired sb"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True )
from Cons.hyps [OF consis']
have "read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))
⊆ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∪ (𝒪 ∪ A - R) ∪ all_acquired sb"
by auto
also from A_shared_owns L_A R_owns A_R
have "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∪ (𝒪 ∪ A - R) ∪ all_acquired sb ⊆
read_only 𝒮 ∪ 𝒪 ∪ (A ∪ all_acquired sb)"
by (auto simp add: read_only_def augment_shared_def restrict_shared_def split: option.splits)
finally
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b )
from Cons.hyps [OF consis']
have "read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))
⊆ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∪ (𝒪 ∪ A - R) ∪ all_acquired sb"
by auto
also from A_shared_owns L_A R_owns A_R
have "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∪ (𝒪 ∪ A - R) ∪ all_acquired sb ⊆
read_only 𝒮 ∪ 𝒪 ∪ (A ∪ all_acquired sb)"
by (auto simp add: read_only_def augment_shared_def restrict_shared_def split: option.splits)
finally
show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
lemma (in valid_ownership_and_sharing) outstanding_non_write_non_vol_reads_drop_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i ≠ j"
assumes ith: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
assumes jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
shows "outstanding_refs is_Write⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) ∩
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
= {}"
proof -
let ?take_j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?take_i = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i)"
let ?drop_i = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i)"
note nvo_i = outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ith]
note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
note nro_i = no_outstanding_write_to_read_only_memory [OF i_bound ith]
with no_write_to_read_only_memory_append [of 𝒮 ?take_i ?drop_i]
have nro_drop_i: "no_write_to_read_only_memory (share ?take_i 𝒮) ?drop_i"
by simp
note nro_j = no_outstanding_write_to_read_only_memory [OF j_bound jth]
with no_write_to_read_only_memory_append [of 𝒮 ?take_j ?drop_j]
have nro_drop_j: "no_write_to_read_only_memory (share ?take_j 𝒮) ?drop_j"
by simp
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
have dist: "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i = {}".
note own_dist = ownership_distinct [OF i_bound j_bound neq_i_j ith jth]
from sharing_consis [OF j_bound jth]
have consis_j: "sharing_consistent 𝒮 𝒪⇩j sb⇩j".
with sharing_consistent_append [of 𝒮 𝒪⇩j ?take_j ?drop_j]
obtain
consis_take_j: "sharing_consistent 𝒮 𝒪⇩j ?take_j" and
consis_drop_j: "sharing_consistent (share ?take_j 𝒮) (acquired True ?take_j 𝒪⇩j) ?drop_j"
by simp
from sharing_consis [OF i_bound ith]
have consis_i: "sharing_consistent 𝒮 𝒪⇩i sb⇩i".
with sharing_consistent_append [of 𝒮 𝒪⇩i ?take_i ?drop_i]
have consis_drop_i: "sharing_consistent (share ?take_i 𝒮) (acquired True ?take_i 𝒪⇩i) ?drop_i"
by simp
{
fix x
assume x_in_drop_i: "x ∈ outstanding_refs is_Write⇩s⇩b ?drop_i"
assume x_in_drop_j: "x ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_j"
have False
proof -
from x_in_drop_i have x_in_i: "x ∈ outstanding_refs is_Write⇩s⇩b sb⇩i"
using outstanding_refs_append [of is_Write⇩s⇩b ?take_i ?drop_i] by auto
from x_in_drop_j have x_in_j: "x ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb⇩j"
using outstanding_refs_append [of is_non_volatile_Read⇩s⇩b ?take_j ?drop_j]
by auto
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_j 𝒮) (acquired True ?take_j 𝒪⇩j) ?drop_j".
from non_volatile_reads_acquired_or_read_only_reads [OF nvo_drop_j ] x_in_drop_j
acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have x_j: "x ∈ 𝒪⇩j ∪ all_acquired sb⇩j ∪ read_only_reads (acquired True ?take_j 𝒪⇩j) ?drop_j"
using all_acquired_append [of ?take_j ?drop_j]
by ( auto )
{
assume x_in_vol_drop_i: "x ∈ outstanding_refs is_volatile_Write⇩s⇩b ?drop_i"
hence x_in_vol_i: "x ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i"
using outstanding_refs_append [of is_volatile_Write⇩s⇩b ?take_i ?drop_i]
by auto
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
have "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i = {}".
with x_in_vol_i x_j obtain
x_unacq_j: "x ∉ 𝒪⇩j ∪ all_acquired sb⇩j" and
x_ror_j: "x ∈ read_only_reads (acquired True ?take_j 𝒪⇩j) ?drop_j"
by auto
from read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_ror_j
have "x ∉ 𝒪⇩i ∪ all_acquired sb⇩i"
by auto
moreover
from read_only_reads_read_only [OF nvo_drop_j consis_drop_j] x_ror_j x_unacq_j
all_acquired_append [of ?take_j ?drop_j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have "x ∈ read_only (share ?take_j 𝒮)"
by (auto)
from read_only_share [OF consis_take_j] this x_unacq_j all_acquired_append [of ?take_j ?drop_j]
have "x ∈ read_only 𝒮"
by auto
with no_unacquired_write_to_read_only'' [OF nro_i consis_i] x_in_i
have "x ∈ 𝒪⇩i ∪ all_acquired sb⇩i"
by auto
ultimately have False by auto
}
moreover
{
assume x_in_non_vol_drop_i: "x ∈ outstanding_refs is_non_volatile_Write⇩s⇩b ?drop_i"
hence "x ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩i"
using outstanding_refs_append [of is_non_volatile_Write⇩s⇩b ?take_i ?drop_i]
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_i]
have "x ∈ 𝒪⇩i ∪ all_acquired sb⇩i" by auto
moreover
with x_j own_dist obtain
x_unacq_j: "x ∉ 𝒪⇩j ∪ all_acquired sb⇩j" and
x_ror_j: "x ∈ read_only_reads (acquired True ?take_j 𝒪⇩j) ?drop_j"
by auto
from read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_ror_j
have "x ∉ 𝒪⇩i ∪ all_acquired sb⇩i"
by auto
ultimately have False
by auto
}
ultimately
show ?thesis
using x_in_drop_i x_in_drop_j
by (auto simp add: misc_outstanding_refs_convs)
qed
}
thus ?thesis
by auto
qed
lemma (in valid_ownership_and_sharing) outstanding_non_volatile_write_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i ≠ j"
assumes ith: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
assumes jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
shows "outstanding_refs (is_non_volatile_Write⇩s⇩b) (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) ∩
(outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ∪
outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) -
read_only_reads 𝒪⇩j (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)) ∪
(𝒪⇩j ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))
) = {}" (is "?non_vol_writes_i ∩ ?not_volatile_j = {}")
proof -
note nro_i = no_outstanding_write_to_read_only_memory [OF i_bound ith]
note nro_j = no_outstanding_write_to_read_only_memory [OF j_bound jth]
note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
note nvo_i = outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ith]
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq_i_j ith jth]
have dist: "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i = {}".
from outstanding_volatile_writes_unowned_by_others [OF j_bound i_bound neq_i_j [symmetric] jth ith]
have dist_j: "(𝒪⇩i ∪ all_acquired sb⇩i) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j = {}".
note own_dist = ownership_distinct [OF i_bound j_bound neq_i_j ith jth]
from sharing_consis [OF j_bound jth]
have consis_j: "sharing_consistent 𝒮 𝒪⇩j sb⇩j".
from sharing_consis [OF i_bound ith]
have consis_i: "sharing_consistent 𝒮 𝒪⇩i sb⇩i".
let ?take_j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
{
fix x
assume x_in_take_i: "x ∈ ?non_vol_writes_i"
assume x_in_j: "x ∈ ?not_volatile_j"
from x_in_take_i have x_in_i: "x ∈ outstanding_refs (is_non_volatile_Write⇩s⇩b) sb⇩i"
by (auto dest: outstanding_refs_takeWhileD)
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_i] x_in_i
have x_in_owns_acq_i: "x ∈ 𝒪⇩i ∪ all_acquired sb⇩i"
by auto
have False
proof -
{
assume x_in_j: "x ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j"
with dist_j have x_notin: "x ∉ (𝒪⇩i ∪ all_acquired sb⇩i)"
by auto
with x_in_owns_acq_i have False
by auto
}
moreover
{
assume x_in_j: "x ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF nvo_j] x_in_j
have "x ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with x_in_owns_acq_i own_dist
have False
by auto
}
moreover
{
assume x_in_j: "x ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_j"
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo': "non_volatile_owned_or_read_only True (share ?take_j 𝒮) (acquired True ?take_j 𝒪⇩j) ?drop_j".
from non_volatile_owned_or_read_only_outstanding_refs [OF nvo'] x_in_j
have "x ∈ acquired True ?take_j 𝒪⇩j ∪ all_acquired ?drop_j ∪
read_only_reads (acquired True ?take_j 𝒪⇩j) ?drop_j"
by (auto simp add: misc_outstanding_refs_convs)
moreover
from acquired_append [of True ?take_j ?drop_j 𝒪⇩j] acquired_all_acquired [of True ?take_j 𝒪⇩j]
all_acquired_append [of ?take_j ?drop_j]
have "acquired True ?take_j 𝒪⇩j ∪ all_acquired ?drop_j ⊆ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
ultimately
have "x ∈ read_only_reads (acquired True ?take_j 𝒪⇩j) ?drop_j"
using x_in_owns_acq_i own_dist
by auto
with read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] jth ith] x_in_owns_acq_i
have False
by auto
}
moreover
{
assume x_in_j: "x ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?take_j"
assume x_notin: "x ∉ read_only_reads 𝒪⇩j ?take_j"
from non_volatile_owned_or_read_only_append [where xs="?take_j" and ys="?drop_j"] nvo_j
have "non_volatile_owned_or_read_only False 𝒮 𝒪⇩j ?take_j"
by auto
from non_volatile_owned_or_read_only_outstanding_refs [OF this] x_in_j x_notin
have "x ∈ 𝒪⇩j ∪ all_acquired ?take_j"
by (auto simp add: misc_outstanding_refs_convs )
with all_acquired_append [of ?take_j ?drop_j] x_in_owns_acq_i own_dist
have False
by auto
}
moreover
{
assume x_in_j: "x ∈ 𝒪⇩j ∪ all_acquired ?take_j"
moreover
from all_acquired_append [of ?take_j ?drop_j]
have "all_acquired ?take_j ⊆ all_acquired sb⇩j"
by auto
ultimately have False
using x_in_owns_acq_i own_dist
by auto
}
ultimately show ?thesis
using x_in_take_i x_in_j
by (auto simp add: misc_outstanding_refs_convs)
qed
}
then show ?thesis
by auto
qed
lemma (in valid_ownership_and_sharing) outstanding_non_volatile_write_not_volatile_read_disj:
assumes i_bound: "i < length ts"
assumes j_bound: "j < length ts"
assumes neq_i_j: "i ≠ j"
assumes ith: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
assumes jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
shows "outstanding_refs (is_non_volatile_Write⇩s⇩b) (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) ∩
outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
(is "?non_vol_writes_i ∩ ?not_volatile_j = {}")
proof -
have "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆
outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ∪
outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by (auto simp add: misc_outstanding_refs_convs dest: outstanding_refs_dropWhileD)
with outstanding_non_volatile_write_disj [OF i_bound j_bound neq_i_j ith jth]
show ?thesis
by blast
qed
lemma (in valid_ownership_and_sharing) outstanding_refs_is_Write⇩s⇩b_takeWhile_disj:
"∀i < length ts. (∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩i,_,_,_) = ts!i;
(_,_,_,sb⇩j,_,_,_) = ts!j
in outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}))"
proof -
{
fix i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume i_bound: "i < length ts"
assume j_bound: "j < length ts"
assume neq_i_j: "i ≠ j"
assume ith: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
assume jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
from outstanding_non_volatile_write_disj [OF j_bound i_bound neq_i_j[symmetric] jth ith]
have "outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
apply (clarsimp simp add: outstanding_refs_is_non_volatile_Write⇩s⇩b_takeWhile_conv)
apply (auto simp add: misc_outstanding_refs_convs )
done
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
fun read_tmps:: "'p store_buffer ⇒ tmp set"
where
"read_tmps [] = {}"
| "read_tmps (r#rs) =
(case r of
Read⇩s⇩b volatile a t v ⇒ insert t (read_tmps rs)
| _ ⇒ read_tmps rs)"
lemma in_read_tmps_conv:
"(t ∈ read_tmps xs) = (∃volatile a v. Read⇩s⇩b volatile a t v ∈ set xs)"
by (induct xs) (auto split: memref.splits)
lemma read_tmps_mono: "⋀ys. set xs ⊆ set ys ⟹ read_tmps xs ⊆ read_tmps ys"
by (fastforce simp add: in_read_tmps_conv)
fun distinct_read_tmps:: "'p store_buffer ⇒ bool"
where
"distinct_read_tmps [] = True"
| "distinct_read_tmps (r#rs) =
(case r of
Read⇩s⇩b volatile a t v ⇒ t ∉ (read_tmps rs) ∧ distinct_read_tmps rs
| _ ⇒ distinct_read_tmps rs)"
lemma distinct_read_tmps_conv:
"distinct_read_tmps xs = (∀i < length xs. ∀j < length xs. i ≠ j ⟶
(case xs!i of
Read⇩s⇩b _ _ t⇩i _ ⇒ case xs!j of Read⇩s⇩b _ _ t⇩j _ ⇒ t⇩i ≠ t⇩j | _ ⇒ True
| _ ⇒ True))"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v)
with Cons.hyps show ?thesis
apply -
apply (rule iffI [rule_format])
apply clarsimp
subgoal for i j
apply (case_tac i)
apply fastforce
apply (case_tac j)
apply (fastforce split: memref.splits)
apply (clarsimp cong: memref.case_cong)
done
apply clarsimp
subgoal for i j
apply (erule_tac x="Suc i" in allE)
apply clarsimp
apply (erule_tac x="Suc j" in allE)
apply (clarsimp cong: memref.case_cong)
done
done
next
case (Read⇩s⇩b volatile a t v)
with Cons.hyps show ?thesis
apply -
apply (rule iffI [rule_format])
apply clarsimp
subgoal for i j
apply (case_tac i)
apply clarsimp
apply (case_tac j)
apply clarsimp
apply (fastforce split: memref.splits simp add: in_read_tmps_conv dest: nth_mem)
apply (clarsimp)
apply (case_tac j)
apply (fastforce split: memref.splits simp add: in_read_tmps_conv dest: nth_mem)
apply (clarsimp cong: memref.case_cong)
done
apply clarsimp
apply (rule conjI)
apply (clarsimp simp add: in_read_tmps_conv)
apply (erule_tac x="0" in allE)
apply (clarsimp simp add: in_set_conv_nth)
subgoal for volatile' a' v' i
apply (erule_tac x="Suc i" in allE)
apply clarsimp
done
apply clarsimp
subgoal for i j
apply (erule_tac x="Suc i" in allE)
apply clarsimp
apply (erule_tac x="Suc j" in allE)
apply (clarsimp cong: memref.case_cong)
done
done
next
case Prog⇩s⇩b
with Cons.hyps show ?thesis
apply -
apply (rule iffI [rule_format])
apply clarsimp
subgoal for i j
apply (case_tac i)
apply fastforce
apply (case_tac j)
apply (fastforce split: memref.splits)
apply (clarsimp cong: memref.case_cong)
done
apply clarsimp
subgoal for i j
apply (erule_tac x="Suc i" in allE)
apply clarsimp
apply (erule_tac x="Suc j" in allE)
apply (clarsimp cong: memref.case_cong)
done
done
next
case Ghost⇩s⇩b
with Cons.hyps show ?thesis
apply -
apply (rule iffI [rule_format])
apply clarsimp
subgoal for i j
apply (case_tac i)
apply fastforce
apply (case_tac j)
apply (fastforce split: memref.splits)
apply (clarsimp cong: memref.case_cong)
done
apply clarsimp
subgoal for i j
apply (erule_tac x="Suc i" in allE)
apply clarsimp
apply (erule_tac x="Suc j" in allE)
apply (clarsimp cong: memref.case_cong)
done
done
qed
qed
fun load_tmps:: "instrs ⇒ tmp set"
where
"load_tmps [] = {}"
| "load_tmps (i#is) =
(case i of
Read volatile a t ⇒ insert t (load_tmps is)
| RMW _ t _ _ _ _ _ _ _ ⇒ insert t (load_tmps is)
| _ ⇒ load_tmps is)"
lemma in_load_tmps_conv:
"(t ∈ load_tmps xs) = ((∃volatile a. Read volatile a t ∈ set xs) ∨
(∃a sop cond ret A L R W. RMW a t sop cond ret A L R W ∈ set xs))"
by (induct xs) (auto split: instr.splits)
lemma load_tmps_mono: "⋀ys. set xs ⊆ set ys ⟹ load_tmps xs ⊆ load_tmps ys"
by (fastforce simp add: in_load_tmps_conv)
fun distinct_load_tmps:: "instrs ⇒ bool"
where
"distinct_load_tmps [] = True"
| "distinct_load_tmps (r#rs) =
(case r of
Read volatile a t ⇒ t ∉ (load_tmps rs) ∧ distinct_load_tmps rs
| RMW a t sop cond ret A L R W ⇒ t ∉ (load_tmps rs) ∧ distinct_load_tmps rs
| _ ⇒ distinct_load_tmps rs)"
locale load_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes load_tmps_distinct:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
distinct_load_tmps is"
locale read_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes read_tmps_distinct:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
distinct_read_tmps sb"
locale load_tmps_read_tmps_distinct =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes load_tmps_read_tmps_distinct:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
load_tmps is ∩ read_tmps sb = {}"
locale tmps_distinct =
load_tmps_distinct +
read_tmps_distinct +
load_tmps_read_tmps_distinct
lemma rev_read_tmps: "read_tmps (rev xs) = read_tmps xs"
by (auto simp add: in_read_tmps_conv)
lemma rev_load_tmps: "load_tmps (rev xs) = load_tmps xs"
by (auto simp add: in_load_tmps_conv)
lemma distinct_read_tmps_append: "⋀ys. distinct_read_tmps (xs @ ys) =
(distinct_read_tmps xs ∧ distinct_read_tmps ys ∧
read_tmps xs ∩ read_tmps ys = {})"
by (induct xs) (auto split: memref.splits simp add: in_read_tmps_conv)
lemma distinct_load_tmps_append: "⋀ys. distinct_load_tmps (xs @ ys) =
(distinct_load_tmps xs ∧ distinct_load_tmps ys ∧
load_tmps xs ∩ load_tmps ys = {})"
apply (induct xs)
apply (auto split: instr.splits simp add: in_load_tmps_conv)
done
lemma read_tmps_append: "read_tmps (xs@ys) = (read_tmps xs ∪ read_tmps ys)"
by (fastforce simp add: in_read_tmps_conv)
lemma load_tmps_append: "load_tmps (xs@ys) = (load_tmps xs ∪ load_tmps ys)"
by (fastforce simp add: in_load_tmps_conv)
fun write_sops:: "'p store_buffer ⇒ sop set"
where
"write_sops [] = {}"
| "write_sops (r#rs) =
(case r of
Write⇩s⇩b volatile a sop v _ _ _ _⇒ insert sop (write_sops rs)
| _ ⇒ write_sops rs)"
lemma in_write_sops_conv:
"(sop ∈ write_sops xs) = (∃volatile a v A L R W. Write⇩s⇩b volatile a sop v A L R W ∈ set xs)"
apply (induct xs)
apply simp
apply (auto split: memref.splits)
apply force
apply force
done
lemma write_sops_mono: "⋀ys. set xs ⊆ set ys ⟹ write_sops xs ⊆ write_sops ys"
by (fastforce simp add: in_write_sops_conv)
lemma write_sops_append: "write_sops (xs@ys) = write_sops xs ∪ write_sops ys"
by (force simp add: in_write_sops_conv)
fun store_sops:: "instrs ⇒ sop set"
where
"store_sops [] = {}"
| "store_sops (i#is) =
(case i of
Write volatile a sop _ _ _ _ ⇒ insert sop (store_sops is)
| RMW a t sop cond ret A L R W ⇒ insert sop (store_sops is)
| _ ⇒ store_sops is)"
lemma in_store_sops_conv:
"(sop ∈ store_sops xs) = ((∃volatile a A L R W. Write volatile a sop A L R W ∈ set xs) ∨
(∃a t cond ret A L R W. RMW a t sop cond ret A L R W ∈ set xs))"
by (induct xs) (auto split: instr.splits)
lemma store_sops_mono: "⋀ys. set xs ⊆ set ys ⟹ store_sops xs ⊆ store_sops ys"
by (fastforce simp add: in_store_sops_conv)
lemma store_sops_append: "store_sops (xs@ys) = store_sops xs ∪ store_sops ys"
by (force simp add: in_store_sops_conv)
locale valid_write_sops =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_write_sops:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹
∀sop ∈ write_sops sb. valid_sop sop"
locale valid_store_sops =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_store_sops:
"⋀i is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹
∀sop ∈ store_sops is. valid_sop sop"
locale valid_sops = valid_write_sops + valid_store_sops
text ‹The value stored in a non-volatile @{const "Read⇩s⇩b"} in the store-buffer has to match the
last value written to the same address in the store buffer
or the memory content if there is no corresponding write in the store buffer.
No volatile read may follow a volatile write.
Volatile reads in the store buffer may refer to a stale value:
e.g. imagine one writer and multiple readers
›
fun reads_consistent:: "bool ⇒ owns ⇒ memory ⇒ 'p store_buffer ⇒ bool"
where
"reads_consistent pending_write 𝒪 m [] = True"
| "reads_consistent pending_write 𝒪 m (r#rs) =
(case r of
Read⇩s⇩b volatile a t v ⇒ (¬ volatile ⟶ (pending_write ∨ a ∈ 𝒪) ⟶ v = m a) ∧
reads_consistent pending_write 𝒪 m rs
| Write⇩s⇩b volatile a sop v A L R W ⇒
(if volatile then
outstanding_refs is_volatile_Read⇩s⇩b rs = {} ∧
reads_consistent True (𝒪 ∪ A - R) (m(a := v)) rs
else reads_consistent pending_write 𝒪 (m(a := v)) rs)
| Ghost⇩s⇩b A L R W ⇒ reads_consistent pending_write (𝒪 ∪ A - R) m rs
| _ ⇒ reads_consistent pending_write 𝒪 m rs
)"
fun volatile_reads_consistent:: "memory ⇒ 'p store_buffer ⇒ bool"
where
"volatile_reads_consistent m [] = True"
| "volatile_reads_consistent m (r#rs) =
(case r of
Read⇩s⇩b volatile a t v ⇒ (volatile ⟶ v = m a) ∧ volatile_reads_consistent m rs
| Write⇩s⇩b volatile a sop v A L R W ⇒ volatile_reads_consistent (m(a := v)) rs
| _ ⇒ volatile_reads_consistent m rs
)"
fun flush:: "'p store_buffer ⇒ memory ⇒ memory"
where
"flush [] m = m"
| "flush (r#rs) m =
(case r of
Write⇩s⇩b volatile a _ v _ _ _ _ ⇒ flush rs (m(a:=v))
| _ ⇒ flush rs m)"
lemma reads_consistent_pending_write_antimono:
"⋀𝒪 m. reads_consistent True 𝒪 m sb ⟹ reads_consistent False 𝒪 m sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒪 m
by (case_tac a) auto
done
lemma reads_consistent_owns_antimono:
"⋀𝒪 𝒪' pending_write m.
𝒪 ⊆ 𝒪' ⟹ reads_consistent pending_write 𝒪' m sb ⟹ reads_consistent pending_write 𝒪 m sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒪 𝒪' pending_write m
apply (case_tac a)
apply (clarsimp split: if_split_asm)
subgoal for volatile a D f v A L R W
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply fastforce
apply fastforce
apply clarsimp
subgoal for A L R W
apply (drule_tac C="A" in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
lemma acquired_reads_mono': "x ∈ acquired_reads b xs A ⟹ acquired_reads b xs B = {} ⟹ A ⊆ B ⟹ False"
apply (drule acquired_reads_mono_in [where B=B])
apply auto
done
lemma reads_consistent_append:
"⋀m pending_write 𝒪. reads_consistent pending_write 𝒪 m (xs@ys) =
(reads_consistent pending_write 𝒪 m xs ∧
reads_consistent (pending_write ∨ outstanding_refs is_volatile_Write⇩s⇩b xs ≠ {})
(acquired True xs 𝒪) (flush xs m) ys ∧
(outstanding_refs is_volatile_Write⇩s⇩b xs ≠ {}
⟶ outstanding_refs is_volatile_Read⇩s⇩b ys = {} ))"
apply (induct xs)
apply clarsimp
subgoal for a xs m pending_write 𝒪
apply (case_tac a)
apply (auto simp add: outstanding_refs_append acquired_reads_append
dest: acquired_reads_mono_in acquired_pending_write_mono_in acquired_reads_mono' acquired_mono_in)
done
done
lemma reads_consistent_mem_eq_on_non_volatile_reads:
assumes mem_eq: "∀a ∈ A. m' a = m a"
assumes subset: "outstanding_refs (is_non_volatile_Read⇩s⇩b) sb ⊆ A"
assumes consis_m: "reads_consistent pending_write 𝒪 m sb"
shows "reads_consistent pending_write 𝒪 m' sb"
using mem_eq subset consis_m
proof (induct sb arbitrary: m' m pending_write 𝒪)
case Nil thus ?case by simp
next
case (Cons r sb)
note mem_eq = ‹∀a ∈ A. m' a = m a›
note subset = ‹outstanding_refs (is_non_volatile_Read⇩s⇩b) (r#sb) ⊆ A›
note consis_m = ‹reads_consistent pending_write 𝒪 m (r#sb)›
from subset have subset': "outstanding_refs is_non_volatile_Read⇩s⇩b sb ⊆ A"
by (auto simp add: Write⇩s⇩b)
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a sop v A' L R W)
from mem_eq
have mem_eq':
"∀a' ∈ A. (m'(a:=v)) a' = (m(a:=v)) a'"
by (auto)
show ?thesis
proof (cases volatile)
case True
from consis_m obtain
consis': "reads_consistent True (𝒪 ∪ A' - R) (m(a := v)) sb" and
no_volatile_Read⇩s⇩b: "outstanding_refs is_volatile_Read⇩s⇩b sb = {}"
by (simp add: Write⇩s⇩b True)
from Cons.hyps [OF mem_eq' subset' consis']
have "reads_consistent True (𝒪 ∪ A' - R) (m'(a := v)) sb".
with no_volatile_Read⇩s⇩b
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False
from consis_m obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) sb"
by (simp add: Write⇩s⇩b False)
from Cons.hyps [OF mem_eq' subset' consis']
have "reads_consistent pending_write 𝒪 (m'(a := v)) sb".
then
show ?thesis
by (simp add: Write⇩s⇩b False)
qed
next
case (Read⇩s⇩b volatile a t v)
from mem_eq
have mem_eq':
"∀a' ∈ A. m' a' = m a'"
by (auto)
show ?thesis
proof (cases volatile)
case True
from consis_m obtain
consis': "reads_consistent pending_write 𝒪 m sb"
by (simp add: Read⇩s⇩b True)
from Cons.hyps [OF mem_eq' subset' consis']
show ?thesis
by (simp add: Read⇩s⇩b True)
next
case False
from consis_m obtain
consis': "reads_consistent pending_write 𝒪 m sb" and v: "(pending_write ∨ a ∈ 𝒪) ⟶ v=m a"
by (simp add: Read⇩s⇩b False)
from mem_eq subset Read⇩s⇩b have "m' a = m a"
by (auto simp add: False)
with Cons.hyps [OF mem_eq' subset' consis'] v
show ?thesis
by (simp add: Read⇩s⇩b False)
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case Ghost⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma volatile_reads_consistent_mem_eq_on_volatile_reads:
assumes mem_eq: "∀a ∈ A. m' a = m a"
assumes subset: "outstanding_refs (is_volatile_Read⇩s⇩b) sb ⊆ A"
assumes consis_m: "volatile_reads_consistent m sb"
shows "volatile_reads_consistent m' sb"
using mem_eq subset consis_m
proof (induct sb arbitrary: m' m)
case Nil thus ?case by simp
next
case (Cons r sb)
note mem_eq = ‹∀a ∈ A. m' a = m a›
note subset = ‹outstanding_refs (is_volatile_Read⇩s⇩b) (r#sb) ⊆ A›
note consis_m = ‹volatile_reads_consistent m (r#sb)›
from subset have subset': "outstanding_refs is_volatile_Read⇩s⇩b sb ⊆ A"
by (auto simp add: Write⇩s⇩b)
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a sop v A' L R W)
from mem_eq
have mem_eq':
"∀a' ∈ A. (m'(a:=v)) a' = (m(a:=v)) a'"
by (auto)
show ?thesis
proof (cases volatile)
case True
from consis_m obtain
consis': "volatile_reads_consistent (m(a := v)) sb"
by (simp add: Write⇩s⇩b True)
from Cons.hyps [OF mem_eq' subset' consis']
have "volatile_reads_consistent (m'(a := v)) sb".
then
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False
from consis_m obtain consis': "volatile_reads_consistent (m(a := v)) sb"
by (simp add: Write⇩s⇩b False)
from Cons.hyps [OF mem_eq' subset' consis']
have "volatile_reads_consistent (m'(a := v)) sb".
then
show ?thesis
by (simp add: Write⇩s⇩b False)
qed
next
case (Read⇩s⇩b volatile a t v)
from mem_eq
have mem_eq':
"∀a' ∈ A. m' a' = m a'"
by (auto)
show ?thesis
proof (cases volatile)
case False
from consis_m obtain
consis': "volatile_reads_consistent m sb"
by (simp add: Read⇩s⇩b False)
from Cons.hyps [OF mem_eq' subset' consis']
show ?thesis
by (simp add: Read⇩s⇩b False)
next
case True
from consis_m obtain
consis': "volatile_reads_consistent m sb" and v: "v=m a"
by (simp add: Read⇩s⇩b True)
from mem_eq subset Read⇩s⇩b v have "v = m' a"
by (auto simp add: True)
with Cons.hyps [OF mem_eq' subset' consis']
show ?thesis
by (simp add: Read⇩s⇩b True)
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case Ghost⇩s⇩b with Cons show ?thesis by auto
qed
qed
locale valid_reads =
fixes m::"memory" and ts::"('p, 'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_reads: "⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
reads_consistent False 𝒪 m sb"
lemma valid_reads_Cons: "valid_reads m (t#ts) =
(let (_,_,_,sb,_,𝒪,_) = t in reads_consistent False 𝒪 m sb ∧ valid_reads m ts)"
apply (auto simp add: valid_reads_def)
subgoal for p' is' θ' sb' 𝒟' 𝒪' ℛ' i p "is" θ sb 𝒟 𝒪 ℛ
apply (case_tac i)
apply auto
done
done
text ‹‹Read⇩s⇩bs› and writes have in the store-buffer have to conform to the
valuation of temporaries.›
context program
begin
fun history_consistent:: "tmps ⇒ 'p ⇒ 'p store_buffer ⇒ bool"
where
"history_consistent θ p [] = True"
| "history_consistent θ p (r#rs) =
(case r of
Read⇩s⇩b vol a t v ⇒
(case θ t of Some v' ⇒ v=v' ∧ history_consistent θ p rs | _ ⇒ False)
| Write⇩s⇩b vol a (D,f) v _ _ _ _ ⇒
D ⊆ dom θ ∧ f θ = v ∧ D ∩ read_tmps rs = {} ∧ history_consistent θ p rs
| Prog⇩s⇩b p⇩1 p⇩2 is ⇒ p⇩1=p ∧
θ|`(dom θ - read_tmps rs)⊢ p⇩1 →⇩p (p⇩2,is) ∧
history_consistent θ p⇩2 rs
| _ ⇒ history_consistent θ p rs)"
end
fun hd_prog:: "'p ⇒ 'p store_buffer ⇒ 'p"
where
"hd_prog p [] = p"
| "hd_prog p (i#is) = (case i of
Prog⇩s⇩b p' _ _ ⇒ p'
| _ ⇒ hd_prog p is)"
fun last_prog:: "'p ⇒ 'p store_buffer ⇒ 'p"
where
"last_prog p [] = p"
| "last_prog p (i#is) = (case i of
Prog⇩s⇩b _ p' _ ⇒ last_prog p' is
| _ ⇒ last_prog p is)"
locale valid_history = program +
constrains
program_step :: "tmps ⇒ 'p ⇒ 'p × instrs ⇒ bool"
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_history: "⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
program.history_consistent program_step θ (hd_prog p sb) sb"
fun data_dependency_consistent_instrs:: "addr set ⇒ instrs ⇒ bool"
where
"data_dependency_consistent_instrs T [] = True"
| "data_dependency_consistent_instrs T (i#is) =
(case i of
Write volatile a (D,f) _ _ _ _ ⇒ D ⊆ T ∧ D ∩ load_tmps is = {} ∧ data_dependency_consistent_instrs T is
| RMW a t (D,f) cond ret _ _ _ _ ⇒ D ⊆ T ∧ D ∩ load_tmps is = {} ∧ data_dependency_consistent_instrs (insert t T) is
| Read _ _ t ⇒ data_dependency_consistent_instrs (insert t T) is
| _ ⇒ data_dependency_consistent_instrs T is)"
lemma data_dependency_consistent_mono:
"⋀ T T'. ⟦data_dependency_consistent_instrs T is; T ⊆ T'⟧ ⟹ data_dependency_consistent_instrs T' is"
apply (induct "is")
apply clarsimp
subgoal for a "is" T T'
apply (case_tac a)
apply clarsimp
subgoal for volatile a' t
apply (drule_tac a=t in insert_mono)
apply clarsimp
done
apply fastforce
apply clarsimp
subgoal for a' t D f cond ret A L R W
apply (frule_tac a=t in insert_mono)
apply fastforce
done
apply fastforce
apply fastforce
done
done
lemma data_dependency_consistent_instrs_append:
"⋀ys T . data_dependency_consistent_instrs T (xs@ys) =
(data_dependency_consistent_instrs T xs ∧
data_dependency_consistent_instrs (T ∪ load_tmps xs) ys ∧
load_tmps ys ∩ ⋃(fst ` store_sops xs) = {})"
apply (induct xs)
apply (auto split: instr.splits simp add: load_tmps_append intro: data_dependency_consistent_mono)
done
locale valid_data_dependency =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes data_dependency_consistent_instrs:
"⋀i p is 𝒪 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
data_dependency_consistent_instrs (dom θ) is"
assumes load_tmps_write_tmps_distinct:
"⋀i p is 𝒪 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
load_tmps is ∩ ⋃(fst ` write_sops sb) = {}"
locale load_tmps_fresh =
fixes ts::"('p, 'p store_buffer,bool,owns,rels) thread_config list"
assumes load_tmps_fresh:
"⋀i p is 𝒪 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
load_tmps is ∩ dom θ = {}"
fun acquired_by_instrs :: "instrs ⇒ addr set ⇒ addr set"
where
"acquired_by_instrs [] A = A"
| "acquired_by_instrs (i#is) A =
(case i of
Read _ _ _ ⇒ acquired_by_instrs is A
| Write volatile _ _ A' L R W ⇒ acquired_by_instrs is (if volatile then (A ∪ A' - R) else A)
| RMW a t sop cond ret A' L R W ⇒ acquired_by_instrs is {}
| Fence ⇒ acquired_by_instrs is {}
| Ghost A' L R W ⇒ acquired_by_instrs is (A ∪ A' - R))"
fun acquired_loads :: "bool ⇒ instrs ⇒ addr set ⇒ addr set"
where
"acquired_loads pending_write [] A = {}"
| "acquired_loads pending_write (i#is) A =
(case i of
Read volatile a _ ⇒ (if pending_write ∧ ¬ volatile ∧ a ∈ A
then insert a (acquired_loads pending_write is A)
else acquired_loads pending_write is A)
| Write volatile _ _ A' L R W ⇒ (if volatile then acquired_loads True is (if pending_write then (A ∪ A' - R) else {})
else acquired_loads pending_write is A)
| RMW a t sop cond ret A' L R W ⇒ acquired_loads pending_write is {}
| Fence ⇒ acquired_loads pending_write is {}
| Ghost A' L R W ⇒ acquired_loads pending_write is (A ∪ A' - R))"
lemma acquired_by_instrs_mono:
"⋀ A B. A ⊆ B ⟹ acquired_by_instrs is A ⊆ acquired_by_instrs is B"
apply (induct "is")
apply simp
subgoal for a "is" A B
apply (case_tac a)
apply clarsimp
apply clarsimp
subgoal for volatile a' D f A' L R W x
apply (drule_tac C=A' in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
apply clarsimp
apply clarsimp
apply clarsimp
subgoal for A' L R W x
apply (drule_tac C=A' in union_mono_aux)
apply (drule_tac C="R" in set_minus_mono_aux)
apply blast
done
done
done
lemma acquired_by_instrs_mono_in:
assumes x_in: "x ∈ acquired_by_instrs is A"
assumes sub: "A ⊆ B"
shows "x ∈ acquired_by_instrs is B"
using acquired_by_instrs_mono [OF sub, of "is"] x_in
by blast
locale enough_flushs =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes clean_no_outstanding_volatile_Write⇩s⇩b:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);¬ 𝒟⟧ ⟹
(outstanding_refs is_volatile_Write⇩s⇩b sb = {})"
fun prog_instrs:: "'p store_buffer ⇒ instrs"
where
"prog_instrs [] = []"
|"prog_instrs (i#is) = (case i of
Prog⇩s⇩b _ _ is' ⇒ is' @ prog_instrs is
| _ ⇒ prog_instrs is)"
fun instrs:: "'p store_buffer ⇒ instrs"
where
"instrs [] = []"
| "instrs (i#is) = (case i of
Write⇩s⇩b volatile a sop v A L R W ⇒ Write volatile a sop A L R W# instrs is
| Read⇩s⇩b volatile a t v ⇒ Read volatile a t # instrs is
| Ghost⇩s⇩b A L R W ⇒ Ghost A L R W# instrs is
| _ ⇒ instrs is)"
locale causal_program_history =
fixes "is⇩s⇩b" and sb
assumes causal_program_history:
"⋀sb⇩1 sb⇩2. sb=sb⇩1@sb⇩2 ⟹ ∃is. instrs sb⇩2 @ is⇩s⇩b = is @ prog_instrs sb⇩2"
lemma causal_program_history_empty [simp]: "causal_program_history is []"
by (rule causal_program_history.intro) simp
lemma causal_program_history_suffix:
"causal_program_history is⇩s⇩b (sb@sb') ⟹ causal_program_history is⇩s⇩b sb'"
by (auto simp add: causal_program_history_def)
locale valid_program_history =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes valid_program_history:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
causal_program_history is sb"
assumes valid_last_prog:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
last_prog p sb = p"
lemma (in valid_program_history) valid_program_history_nth_update:
"⟦i < length ts; causal_program_history is sb; last_prog p sb = p⟧
⟹
valid_program_history (ts [i:=(p,is,θ,sb,𝒟,𝒪,ℛ)])"
by (rule valid_program_history.intro)
(auto dest: valid_program_history valid_last_prog
simp add: nth_list_update split: if_split_asm)
lemma (in outstanding_non_volatile_refs_owned_or_read_only)
outstanding_non_volatile_refs_owned_instructions_read_value_independent:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
outstanding_non_volatile_refs_owned_or_read_only 𝒮 (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
by (unfold_locales)
(auto dest: outstanding_non_volatile_refs_owned_or_read_only
simp add: nth_list_update split: if_split_asm)
lemma (in outstanding_non_volatile_refs_owned_or_read_only)
outstanding_non_volatile_refs_owned_or_read_only_nth_update:
"⋀i is 𝒪 𝒟 ℛ θ sb.
⟦i < length ts; non_volatile_owned_or_read_only False 𝒮 𝒪 sb⟧ ⟹
outstanding_non_volatile_refs_owned_or_read_only 𝒮 (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: outstanding_non_volatile_refs_owned_or_read_only
simp add: nth_list_update split: if_split_asm)
lemma (in outstanding_volatile_writes_unowned_by_others)
outstanding_volatile_writes_unowned_by_others_instructions_read_value_independent:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
outstanding_volatile_writes_unowned_by_others (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
by (unfold_locales)
(auto dest: outstanding_volatile_writes_unowned_by_others
simp add: nth_list_update split: if_split_asm)
lemma (in read_only_reads_unowned)
read_only_unowned_instructions_read_value_independent:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧ ⟹
read_only_reads_unowned (ts[i := (p',is',θ',sb,𝒟',𝒪,ℛ')])"
by (unfold_locales)
(auto dest: read_only_reads_unowned
simp add: nth_list_update split: if_split_asm)
lemma Write⇩s⇩b_in_outstanding_refs:
"Write⇩s⇩b True a sop v A L R W ∈ set xs ⟹ a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (induct xs) (auto split:memref.splits)
lemma (in outstanding_volatile_writes_unowned_by_others)
outstanding_volatile_writes_unowned_by_others_store_buffer:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
outstanding_refs is_volatile_Write⇩s⇩b sb' ⊆ outstanding_refs is_volatile_Write⇩s⇩b sb;
all_acquired sb' ⊆ all_acquired sb⟧ ⟹
outstanding_volatile_writes_unowned_by_others (ts[i := (p',is',θ',sb',𝒟',𝒪,ℛ')])"
apply (unfold_locales)
apply (fastforce dest: outstanding_volatile_writes_unowned_by_others
simp add: nth_list_update split: if_split_asm)
done
lemma (in ownership_distinct)
ownership_distinct_instructions_read_value_store_buffer_independent:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
all_acquired sb' ⊆ all_acquired sb⟧ ⟹
ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪,ℛ')])"
by (unfold_locales)
(auto dest: ownership_distinct
simp add: nth_list_update split: if_split_asm)
lemma (in ownership_distinct)
ownership_distinct_nth_update:
"⋀i p is 𝒪 ℛ 𝒟 xs sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
∀j < length ts. i≠j ⟶ (let (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j) = ts!j
in (𝒪' ∪ all_acquired sb') ∩ (𝒪⇩j ∪ all_acquired sb⇩j) ={}) ⟧ ⟹
ownership_distinct (ts[i := (p',is',θ',sb',𝒟',𝒪',ℛ')])"
apply (unfold_locales)
apply (clarsimp simp add: nth_list_update split: if_split_asm)
apply (force dest: ownership_distinct simp add: Let_def)
apply (fastforce dest: ownership_distinct simp add: Let_def)
apply (fastforce dest: ownership_distinct simp add: Let_def)
done
lemma (in valid_write_sops) valid_write_sops_nth_update:
"⟦i < length ts; ∀sop ∈ write_sops sb. valid_sop sop⟧ ⟹
valid_write_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold valid_write_sops_def)
(auto dest: valid_write_sops simp add: nth_list_update split: if_split_asm)
lemma (in valid_store_sops) valid_store_sops_nth_update:
"⟦i < length ts; ∀sop ∈ store_sops is. valid_sop sop⟧ ⟹
valid_store_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold valid_store_sops_def)
(auto dest: valid_store_sops simp add: nth_list_update split: if_split_asm)
lemma (in valid_sops) valid_sops_nth_update:
"⟦i < length ts; ∀sop ∈ write_sops sb. valid_sop sop;
∀sop ∈ store_sops is. valid_sop sop⟧ ⟹
valid_sops (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold valid_sops_def valid_write_sops_def valid_store_sops_def)
(auto dest: valid_write_sops valid_store_sops
simp add: nth_list_update split: if_split_asm)
lemma (in valid_data_dependency) valid_data_dependency_nth_update:
"⟦i < length ts; data_dependency_consistent_instrs (dom θ) is;
load_tmps is ∩ ⋃(fst ` write_sops sb) = {}⟧ ⟹
valid_data_dependency (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
by (unfold valid_data_dependency_def)
(force dest: data_dependency_consistent_instrs load_tmps_write_tmps_distinct
simp add: nth_list_update split: if_split_asm)
lemma (in enough_flushs) enough_flushs_nth_update:
"⟦i < length ts;
¬ 𝒟 ⟶ (outstanding_refs is_volatile_Write⇩s⇩b sb = {})
⟧ ⟹
enough_flushs (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
apply (unfold_locales)
apply (force simp add: nth_list_update split: if_split_asm dest: clean_no_outstanding_volatile_Write⇩s⇩b)
done
lemma (in outstanding_non_volatile_writes_unshared)
outstanding_non_volatile_writes_unshared_nth_update:
"⟦i < length ts; non_volatile_writes_unshared 𝒮 sb⟧ ⟹
outstanding_non_volatile_writes_unshared 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: outstanding_non_volatile_writes_unshared
simp add: nth_list_update split: if_split_asm)
lemma (in sharing_consis)
sharing_consis_nth_update:
"⟦i < length ts; sharing_consistent 𝒮 𝒪 sb⟧ ⟹
sharing_consis 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: sharing_consis
simp add: nth_list_update split: if_split_asm)
lemma (in no_outstanding_write_to_read_only_memory)
no_outstanding_write_to_read_only_memory_nth_update:
"⟦i < length ts; no_write_to_read_only_memory 𝒮 sb⟧ ⟹
no_outstanding_write_to_read_only_memory 𝒮 (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: no_outstanding_write_to_read_only_memory
simp add: nth_list_update split: if_split_asm)
lemma in_Union_image_nth_conv: "a ∈ ⋃ (f ` set xs) ⟹ ∃i. i < length xs ∧ a ∈ f (xs!i)"
by (auto simp add: in_set_conv_nth)
lemma in_Inter_image_nth_conv: "a ∈ ⋂ (f ` set xs) = (∀i < length xs. a ∈ f (xs!i))"
by (force simp add: in_set_conv_nth)
lemma release_ownership_nth_update:
assumes R_subset: "R ⊆ 𝒪"
shows "⋀i. ⟦i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,ℛ);
ownership_distinct ts⟧
⟹ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪 - R,ℛ')]))
= ((⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)) - R )"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
note i_bound = ‹i < length (t # ts)›
note ith = ‹(t # ts) ! i = (p,is,xs, sb, 𝒟, 𝒪,ℛ)›
note dist = ‹ownership_distinct (t#ts)›
then interpret ownership_distinct "t#ts".
from dist
have dist': "ownership_distinct ts"
by (rule ownership_distinct_tl)
show ?case
proof (cases i)
case 0
from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
have "R ∩ (⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)) = {}"
proof -
{
fix x
assume x_R: "x ∈ R"
assume x_ls: "x ∈ (⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts))"
then obtain j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j where
j_bound: "j < length ts" and
jth: "ts!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)" and
x_in: "x ∈ 𝒪⇩j"
by (fastforce simp add: in_set_conv_nth )
from j_bound jth 0
have "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}"
apply -
apply (rule ownership_distinct [OF i_bound _ _ ith, of "Suc j"])
apply clarsimp+
apply blast
done
with x_R R_subset x_in have False
by auto
}
thus ?thesis
by blast
qed
then
show ?thesis
by (auto simp add: 0 t)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where t: "t = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases t)
have n_bound: "n < length ts"
using i_bound by (simp add: Suc)
have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,ℛ)"
using ith by (simp add: Suc)
have "R ∩ (𝒪⇩l ∪ all_acquired sb⇩l) = {}"
proof -
{
fix x
assume x_R: "x ∈ R"
assume x_owns⇩l: "x ∈ (𝒪⇩l ∪ all_acquired sb⇩l)"
from t
have "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩l ∪ all_acquired sb⇩l)= {}"
apply -
apply (rule ownership_distinct [OF i_bound _ _ ith, of "0"])
apply (auto simp add: Suc)
done
with x_owns⇩l x_R R_subset have False
by auto
}
thus ?thesis
by blast
qed
with Cons.hyps [OF n_bound nth dist']
show ?thesis
by (auto simp add: Suc t)
qed
qed
lemma acquire_ownership_nth_update:
shows "⋀i. ⟦i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,ℛ)⟧
⟹ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪 ∪ A,ℛ')]))
= ((⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)) ∪ A )"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
note i_bound = ‹i < length (t # ts)›
note ith = ‹(t # ts) ! i = (p,is, xs, sb, 𝒟, 𝒪, ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
show ?thesis
by (auto simp add: 0 t)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where t: "t = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases t)
have n_bound: "n < length ts"
using i_bound by (simp add: Suc)
have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,ℛ)"
using ith by (simp add: Suc)
from Cons.hyps [OF n_bound nth]
show ?thesis
by (auto simp add: Suc t)
qed
qed
lemma acquire_release_ownership_nth_update:
assumes R_subset: "R ⊆ 𝒪"
shows "⋀i. ⟦i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,ℛ);
ownership_distinct ts⟧
⟹ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set (ts[i:=(p',is',xs',sb',𝒟',𝒪 ∪ A - R,ℛ')]))
= ((⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)) ∪ A - R )"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
note i_bound = ‹i < length (t # ts)›
note ith = ‹(t # ts) ! i = (p,is, xs, sb,𝒟, 𝒪,ℛ)›
note dist = ‹ownership_distinct (t#ts)›
then interpret ownership_distinct "t#ts".
from dist
have dist': "ownership_distinct ts"
by (rule ownership_distinct_tl)
show ?case
proof (cases i)
case 0
from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
have "R ∩ (⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)) = {}"
proof -
{
fix x
assume x_R: "x ∈ R"
assume x_ls: "x ∈ (⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts))"
then obtain j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j where
j_bound: "j < length ts" and
jth: "ts!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)" and
x_in: "x ∈ 𝒪⇩j"
by (fastforce simp add: in_set_conv_nth )
from j_bound jth 0
have "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}"
apply -
apply (rule ownership_distinct [OF i_bound _ _ ith, of "Suc j"])
apply clarsimp+
apply blast
done
with x_R R_subset x_in have False
by auto
}
thus ?thesis
by blast
qed
then
show ?thesis
by (auto simp add: 0 t)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where t: "t = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases t)
have n_bound: "n < length ts"
using i_bound by (simp add: Suc)
have nth: "ts!n = (p,is,xs,sb,𝒟,𝒪,ℛ)"
using ith by (simp add: Suc)
have "R ∩ (𝒪⇩l ∪ all_acquired sb⇩l) = {}"
proof -
{
fix x
assume x_R: "x ∈ R"
assume x_owns⇩l: "x ∈ (𝒪⇩l ∪ all_acquired sb⇩l)"
from t
have "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩l ∪ all_acquired sb⇩l)= {}"
apply -
apply (rule ownership_distinct [OF i_bound _ _ ith, of "0"])
apply (auto simp add: Suc)
done
with x_owns⇩l x_R R_subset have False
by auto
}
thus ?thesis
by blast
qed
with Cons.hyps [OF n_bound nth dist']
show ?thesis
by (auto simp add: Suc t)
qed
qed
lemma (in valid_history) valid_history_nth_update:
"⟦i < length ts; history_consistent θ (hd_prog p sb) sb ⟧ ⟹
valid_history program_step (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: valid_history simp add: nth_list_update split: if_split_asm)
lemma (in valid_reads) valid_reads_nth_update:
"⟦i < length ts; reads_consistent False 𝒪 m sb ⟧ ⟹
valid_reads m (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: valid_reads simp add: nth_list_update split: if_split_asm)
lemma (in load_tmps_distinct) load_tmps_distinct_nth_update:
"⟦i < length ts; distinct_load_tmps is⟧ ⟹
load_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: load_tmps_distinct simp add: nth_list_update split: if_split_asm)
lemma (in read_tmps_distinct) read_tmps_distinct_nth_update:
"⟦i < length ts; distinct_read_tmps sb⟧ ⟹
read_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: read_tmps_distinct simp add: nth_list_update split: if_split_asm)
lemma (in load_tmps_read_tmps_distinct) load_tmps_read_tmps_distinct_nth_update:
"⟦i < length ts; load_tmps is ∩ read_tmps sb = {}⟧ ⟹
load_tmps_read_tmps_distinct (ts[i := (p,is,xs,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(auto dest: load_tmps_read_tmps_distinct simp add: nth_list_update split: if_split_asm)
lemma (in load_tmps_fresh) load_tmps_fresh_nth_update:
"⟦i < length ts;
load_tmps is ∩ dom θ = {}⟧ ⟹
load_tmps_fresh (ts[i := (p,is,θ,sb,𝒟,𝒪,ℛ)])"
by (unfold_locales)
(fastforce dest: load_tmps_fresh
simp add: nth_list_update split: if_split_asm)
fun flush_all_until_volatile_write::
"('p,'p store_buffer,'dirty,'owns,'rels) thread_config list ⇒ memory ⇒ memory"
where
"flush_all_until_volatile_write [] m = m"
| "flush_all_until_volatile_write ((_, _, _, sb,_, _)#ts) m =
flush_all_until_volatile_write ts (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m)"
fun share_all_until_volatile_write::
"('p,'p store_buffer,'dirty,'owns,'rels) thread_config list ⇒ shared ⇒ shared"
where
"share_all_until_volatile_write [] S = S"
| "share_all_until_volatile_write ((_, _, _, sb,_,_)#ts) S =
share_all_until_volatile_write ts (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S)"
lemma takeWhile_dropWhile_real_prefix:
"⟦x ∈ set xs; ¬ P x⟧ ⟹ ∃y ys. xs=takeWhile P xs @ y#ys ∧ ¬ P y ∧ dropWhile P xs = y#ys"
by (induct xs) auto
lemma buffered_val_witness: "buffered_val sb a = Some v ⟹
∃volatile sop A L R W. Write⇩s⇩b volatile a sop v A L R W ∈ set sb"
apply (induct sb)
apply simp
apply (clarsimp split: memref.splits option.splits if_split_asm)
apply blast
apply blast
done
lemma flush_append_Read⇩s⇩b:
"⋀m. (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t v])) m)
= flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m"
by (induct sb) (auto split: memref.splits)
lemma flush_append_write:
"⋀m. (flush (sb @ [Write⇩s⇩b volatile a sop v A L R W]) m) = (flush sb m) (a:=v)"
by (induct sb) (auto split: memref.splits)
lemma flush_append_Prog⇩s⇩b:
"⋀m. (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])) m) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m) "
by (induct sb) (auto split: memref.splits)
lemma flush_append_Ghost⇩s⇩b:
"⋀m. (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Ghost⇩s⇩b A L R W])) m) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m) "
by (induct sb) (auto split: memref.splits)
lemma share_append: "⋀S. share (xs@ys) S = share ys (share xs S)"
by (induct xs) (auto split: memref.splits)
lemma share_append_Read⇩s⇩b:
"⋀S. (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t v])) S)
= share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S"
by (induct sb) (auto split: memref.splits)
lemma share_append_Write⇩s⇩b:
"⋀S. (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Write⇩s⇩b volatile a sop v A L R W])) S)
= share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S"
by (induct sb) (auto split: memref.splits)
lemma share_append_Prog⇩s⇩b:
"⋀S. (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])) S) =
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S) "
by (induct sb) (auto split: memref.splits)
lemma in_acquired_no_pending_write_outstanding_write:
"a ∈ acquired False sb A ⟹ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}"
apply (induct sb)
apply (auto split: memref.splits)
done
lemma flush_buffered_val_conv:
"⋀m. flush sb m a = (case buffered_val sb a of None ⇒ m a | Some v ⇒ v)"
by (induct sb) (auto split: memref.splits option.splits)
lemma reads_consistent_unbuffered_snoc:
"⋀m. buffered_val sb a = None ⟹ m a = v ⟹ reads_consistent pending_write 𝒪 m sb ⟹
volatile ⟶
outstanding_refs is_volatile_Write⇩s⇩b sb = {}
⟹ reads_consistent pending_write 𝒪 m (sb @ [Read⇩s⇩b volatile a t v])"
by (simp add: reads_consistent_append flush_buffered_val_conv)
lemma reads_consistent_buffered_snoc:
"⋀m. buffered_val sb a = Some v ⟹ reads_consistent pending_write 𝒪 m sb ⟹
volatile ⟶ outstanding_refs is_volatile_Write⇩s⇩b sb = {}
⟹ reads_consistent pending_write 𝒪 m (sb @ [Read⇩s⇩b volatile a t v])"
by (simp add: reads_consistent_append flush_buffered_val_conv)
lemma reads_consistent_snoc_Write⇩s⇩b:
"⋀m. reads_consistent pending_write 𝒪 m sb ⟹
reads_consistent pending_write 𝒪 m (sb @ [Write⇩s⇩b volatile a sop v A L R W])"
by (simp add: reads_consistent_append)
lemma reads_consistent_snoc_Prog⇩s⇩b:
"⋀m. reads_consistent pending_write 𝒪 m sb ⟹ reads_consistent pending_write 𝒪 m (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])"
by (simp add: reads_consistent_append)
lemma reads_consistent_snoc_Ghost⇩s⇩b:
"⋀m. reads_consistent pending_write 𝒪 m sb ⟹ reads_consistent pending_write 𝒪 m (sb @ [Ghost⇩s⇩b A L R W])"
by (simp add: reads_consistent_append)
lemma restrict_map_id [simp]:"m |` dom m = m"
apply (rule ext)
subgoal for x
apply (case_tac "m x")
apply (auto simp add: restrict_map_def domIff)
done
done
lemma flush_all_until_volatile_write_Read_commute:
shows "⋀m i. ⟦i < length ls; ls!i=(p,Read volatile a t#is,θ,sb,𝒟,𝒪,ℛ)
⟧
⟹
flush_all_until_volatile_write
(ls[i := (p,is , θ(t↦v), sb @ [Read⇩s⇩b volatile a t v],𝒟',𝒪',ℛ')]) m =
flush_all_until_volatile_write ls m"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,Read volatile a t#is,θ,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,Read volatile a t#is,θ,sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 flush_append_Read⇩s⇩b del: fun_upd_apply )
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write
(ls[n := (p,is , θ(t↦v), sb @ [Read⇩s⇩b volatile a t v],𝒟',𝒪',ℛ') ])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ls (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then
show ?thesis
by (simp add: Suc l del: fun_upd_apply)
qed
qed
lemma flush_all_until_volatile_write_append_Ghost_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p',is',θ', sb@[Ghost⇩s⇩b A L R W], 𝒟', 𝒪',ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 flush_append_Ghost⇩s⇩b del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write
(ts[n := (p',is',θ', sb@[Ghost⇩s⇩b A L R W], 𝒟', 𝒪',ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then show ?thesis
by (simp add: Suc l)
qed
qed
lemma update_commute:
assumes g_unchanged: "∀a m. a ∉ G ⟶ g m a = m a"
assumes g_independent: "∀a m. a ∈ G ⟶ g (f m) a = g m a"
assumes f_unchanged: "∀a m. a ∉ F ⟶ f m a = m a"
assumes f_independent: "∀a m. a ∈ F ⟶ f (g m) a = f m a"
assumes disj: "G ∩ F = {}"
shows "f (g m) = g (f m)"
proof
fix a
show "f (g m) a = g (f m) a"
proof (cases "a ∈ G")
case True
with disj have a_notin_F: "a ∉ F"
by blast
from f_unchanged [rule_format, OF a_notin_F, of "g m"]
have "f (g m) a = g m a" .
also
from g_independent [rule_format, OF True]
have "… = g (f m) a" by simp
finally show ?thesis .
next
case False
note a_notin_G = this
show ?thesis
proof (cases "a ∈ F")
case True
from f_independent [rule_format, OF True]
have "f (g m) a = f m a" by simp
also
from g_unchanged [rule_format, OF a_notin_G]
have "… = g (f m) a"
by simp
finally show ?thesis .
next
case False
from f_unchanged [rule_format, OF False]
have "f (g m) a = g m a".
also
from g_unchanged [rule_format, OF a_notin_G]
have "… = m a" .
also
from f_unchanged [rule_format, OF False]
have "… = f m a" by simp
also
from g_unchanged [rule_format, OF a_notin_G]
have "… = g (f m) a"
by simp
finally show ?thesis .
qed
qed
qed
lemma update_commute':
assumes g_unchanged: "∀a m. a ∉ G ⟶ g m a = m a"
assumes g_independent: "∀a m⇩1 m⇩2. a ∈ G ⟶ g m⇩1 a = g m⇩2 a"
assumes f_unchanged: "∀a m. a ∉ F ⟶ f m a = m a"
assumes f_independent: "∀a m⇩1 m⇩2. a ∈ F ⟶ f m⇩1 a = f m⇩2 a"
assumes disj: "G ∩ F = {}"
shows "f (g m) = g (f m)"
proof -
from g_independent have g_ind': "∀a m. a ∈ G ⟶ g (f m) a = g m a" by blast
from f_independent have f_ind': "∀a m. a ∈ F ⟶ f (g m) a = f m a" by blast
from update_commute [OF g_unchanged g_ind' f_unchanged f_ind' disj]
show ?thesis .
qed
lemma flush_unchanged_addresses: "⋀m. a ∉ outstanding_refs is_Write⇩s⇩b sb ⟹ flush sb m a = m a"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons r sb)
note a_notin = ‹a ∉ outstanding_refs is_Write⇩s⇩b (r#sb)›
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a' sop v)
from a_notin obtain neq_a_a': "a≠a'" and a_notin': "a ∉ outstanding_refs is_Write⇩s⇩b sb"
by (simp add: Write⇩s⇩b)
from Cons.hyps [OF a_notin', of "m(a':=v)"] neq_a_a'
show ?thesis
apply (simp add: Write⇩s⇩b del: fun_upd_apply)
apply simp
done
next
case (Read⇩s⇩b volatile a' t v)
from a_notin obtain a_notin': "a ∉ outstanding_refs is_Write⇩s⇩b sb"
by (simp add: Read⇩s⇩b)
from Cons.hyps [OF a_notin', of "m"]
show ?thesis
by (simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b with Cons show ?thesis by simp
next
case Ghost⇩s⇩b with Cons show ?thesis by simp
qed
qed
lemma flushed_values_mem_independent:
"⋀m m' a. a ∈ outstanding_refs is_Write⇩s⇩b sb ⟹ flush sb m' a = flush sb m a"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons r sb)
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a' sop' v')
have "flush sb (m'(a' := v')) a' = flush sb (m(a' := v')) a'"
proof (cases "a' ∈ outstanding_refs is_Write⇩s⇩b sb")
case True
from Cons.hyps [OF this]
show ?thesis .
next
case False
from flush_unchanged_addresses [OF False]
show ?thesis
by simp
qed
with Cons.hyps Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b)
next
case Read⇩s⇩b thus ?thesis using Cons
by auto
next
case Prog⇩s⇩b thus ?thesis using Cons
by auto
next
case Ghost⇩s⇩b thus ?thesis using Cons
by auto
qed
qed
lemma flush_all_until_volatile_write_unchanged_addresses:
"⋀m. a ∉ ⋃((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls) ⟹
flush_all_until_volatile_write ls m a = m a"
proof (induct ls)
case Nil thus ?case by simp
next
case (Cons l ls)
obtain p "is" 𝒪 ℛ 𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,ℛ)"
by (cases l)
note ‹a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set (l#ls))›
then obtain
a_notin_sb: "a ∉ outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)" and
a_notin_ls: "a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls)"
by (auto simp add: l)
from Cons.hyps [OF a_notin_ls]
have "flush_all_until_volatile_write ls (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m) a
=
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m) a".
also
from flush_unchanged_addresses [OF a_notin_sb]
have "(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m) a = m a".
finally
show ?case
by (simp add: l)
qed
lemma notin_outstanding_non_volatile_takeWhile_lem:
"a ∉ outstanding_refs (Not ∘ is_volatile) sb
⟹
a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply (auto simp add: is_Write⇩s⇩b_def split: if_split_asm memref.splits)
done
lemma notin_outstanding_non_volatile_takeWhile_lem':
"a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb
⟹
a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply (auto simp add: is_Write⇩s⇩b_def split: if_split_asm memref.splits)
done
lemma notin_outstanding_non_volatile_takeWhile_Un_lem':
"a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not ∘ is_volatile) sb) ` set ls)
⟹ a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls)"
proof (induct ls)
case Nil thus ?case by simp
next
case (Cons l ls)
obtain p "is" 𝒪 ℛ 𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,ℛ)"
by (cases l)
from Cons.prems
obtain
a_notin_sb: "a ∉ outstanding_refs (Not ∘ is_volatile) sb" and
a_notin_ls: "a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not ∘ is_volatile) sb) ` set ls)"
by (force simp add: l simp del: o_apply)
from notin_outstanding_non_volatile_takeWhile_lem [OF a_notin_sb]
Cons.hyps [OF a_notin_ls]
show ?case
by (auto simp add: l simp del: o_apply)
qed
lemma flush_all_until_volatile_write_unchanged_addresses':
assumes notin: "a ∉ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs (Not ∘ is_volatile) sb) ` set ls)"
shows "flush_all_until_volatile_write ls m a = m a"
using notin_outstanding_non_volatile_takeWhile_Un_lem' [OF notin]
by (auto intro: flush_all_until_volatile_write_unchanged_addresses)
lemma flush_all_until_volatile_wirte_mem_independent:
"⋀m m'. a ∈ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls) ⟹
flush_all_until_volatile_write ls m' a = flush_all_until_volatile_write ls m a"
proof (induct ls)
case Nil thus ?case by simp
next
case (Cons l ls)
obtain p "is" 𝒪 ℛ 𝒟 xs sb where l: "l=(p,is,xs,sb,𝒟,𝒪,ℛ)"
by (cases l)
note a_in = ‹a ∈ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set (l#ls))›
show ?case
proof (cases "a ∈ ⋃ ((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls)")
case True
from Cons.hyps [OF this]
show ?thesis
by (simp add: l)
next
case False
with a_in
have "a ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: l)
from flushed_values_mem_independent [rule_format, OF this]
have "flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m' a =
flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m a".
with flush_all_until_volatile_write_unchanged_addresses [OF False]
show ?thesis
by (auto simp add: l)
qed
qed
lemma flush_all_until_volatile_write_buffered_val_conv:
assumes no_volatile_Write⇩s⇩b: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows"⋀m i. ⟦i < length ls; ls!i = (p,is,xs,sb,𝒟,𝒪,ℛ);
∀j < length ls. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ls!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)) ⟧ ⟹
flush_all_until_volatile_write ls m a =
(case buffered_val sb a of None ⇒ m a | Some v ⇒ v)"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,is,xs,sb,𝒟,𝒪,ℛ)›
note notin = ‹∀j < length (l#ls). i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = (l#ls)!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
from no_volatile_Write⇩s⇩b have take_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
have "a ∉ ⋃((λ(_,_, _, sb, _,_,_).
outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ls)" (is "a ∉ ?LS")
proof
assume "a ∈ ?LS"
from in_Union_image_nth_conv [OF this]
obtain j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j "𝒟⇩j" "xs⇩j" "sb⇩j" where
j_bound: "j < length ls" and
jth: "ls!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)" and
a_in_j: "a ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by fastforce
from a_in_j obtain v' sop' A L R W where "Write⇩s⇩b False a sop' v' A L R W∈ set (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
apply (clarsimp simp add: outstanding_refs_conv )
subgoal for x
apply (case_tac x)
apply clarsimp
apply (frule set_takeWhileD)
apply auto
done
done
with notin [rule_format, of "Suc j"] j_bound jth
show False
by (force simp add: 0 outstanding_refs_conv is_non_volatile_Write⇩s⇩b_def
split: memref.splits)
qed
from flush_all_until_volatile_write_unchanged_addresses [OF this]
have "flush_all_until_volatile_write ls (flush sb m) a = (flush sb m) a"
by (simp add: take_all)
then
show ?thesis
by (simp add: 0 l take_all flush_buffered_val_conv)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where l: "l = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l )"
by (cases l)
from i_bound ith notin
have "flush_all_until_volatile_write ls
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) a
= (case buffered_val sb a of None ⇒
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) a | Some v ⇒ v)"
apply -
apply (rule Cons.hyps)
apply (force simp add: Suc Let_def simp del: o_apply)+
done
moreover
from notin [rule_format, of 0] l
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l)"
by (auto simp add: Let_def outstanding_refs_conv Suc )
then
have "a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l)"
apply (clarsimp simp add: outstanding_refs_conv is_Write⇩s⇩b_def split: memref.splits dest: set_takeWhileD)
apply (frule set_takeWhileD)
apply force
done
from flush_unchanged_addresses [OF this]
have "(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) a = m a" .
ultimately
show ?thesis
by (simp add: Suc l split: option.splits)
qed
qed
context program
begin
abbreviation sb_concurrent_step ::
"('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config ⇒ ('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config ⇒ bool"
("_ ⇒⇩s⇩b _" [60,60] 100)
where
"sb_concurrent_step ≡
computation.concurrent_step sb_memop_step store_buffer_step program_step (λp p' is sb. sb)"
term "x ⇒⇩s⇩b Y"
abbreviation (in program) sb_concurrent_steps::
"('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config ⇒ ('p,'p store_buffer,'dirty,'owns,'rels,'shared) global_config ⇒ bool"
("_ ⇒⇩s⇩b⇧* _" [60,60] 100)
where
"sb_concurrent_steps ≡ sb_concurrent_step^**"
term "x ⇒⇩s⇩b⇧* Y"
abbreviation sbh_concurrent_step ::
"('p,'p store_buffer,bool,owns,rels,shared) global_config ⇒ ('p,'p store_buffer,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩s⇩b⇩h _" [60,60] 100)
where
"sbh_concurrent_step ≡
computation.concurrent_step sbh_memop_step flush_step program_step
(λp p' is sb. sb @ [Prog⇩s⇩b p p' is] )"
term "x ⇒⇩s⇩b⇩h Y"
abbreviation sbh_concurrent_steps::
"('p,'p store_buffer,bool,owns,rels,shared) global_config ⇒ ('p,'p store_buffer,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩s⇩b⇩h⇧* _" [60,60] 100)
where
"sbh_concurrent_steps ≡ sbh_concurrent_step^**"
term "x ⇒⇩s⇩b⇩h⇧* Y"
end
lemma instrs_append_Read⇩s⇩b:
"instrs (sb@[Read⇩s⇩b volatile a t v]) = instrs sb @ [Read volatile a t]"
by (induct sb) (auto split: memref.splits)
lemma instrs_append_Write⇩s⇩b:
"instrs (sb@[Write⇩s⇩b volatile a sop v A L R W]) = instrs sb @ [Write volatile a sop A L R W]"
by (induct sb) (auto split: memref.splits)
lemma instrs_append_Ghost⇩s⇩b:
"instrs (sb@[Ghost⇩s⇩b A L R W]) = instrs sb @ [Ghost A L R W]"
by (induct sb) (auto split: memref.splits)
lemma prog_instrs_append_Ghost⇩s⇩b:
"prog_instrs (sb@[Ghost⇩s⇩b A L R W]) = prog_instrs sb"
by (induct sb) (auto split: memref.splits)
lemma prog_instrs_append_Read⇩s⇩b:
"prog_instrs (sb@[Read⇩s⇩b volatile a t v]) = prog_instrs sb "
by (induct sb) (auto split: memref.splits)
lemma prog_instrs_append_Write⇩s⇩b:
"prog_instrs (sb@[Write⇩s⇩b volatile a sop v A L R W]) = prog_instrs sb"
by (induct sb) (auto split: memref.splits)
lemma hd_prog_append_Read⇩s⇩b:
"hd_prog p (sb@[Read⇩s⇩b volatile a t v]) = hd_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma hd_prog_append_Write⇩s⇩b:
"hd_prog p (sb@[Write⇩s⇩b volatile a sop v A L R W]) = hd_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma flush_update_other: "⋀m. a ∉ outstanding_refs (Not ∘ is_volatile) sb ⟹
outstanding_refs (is_volatile_Write⇩s⇩b) sb = {} ⟹
flush sb (m(a:=v)) = (flush sb m)(a := v)"
by (induct sb)
(auto split: memref.splits if_split_asm simp add: fun_upd_twist)
lemma flush_update_other': "⋀m. a ∉ outstanding_refs (is_non_volatile_Write⇩s⇩b) sb ⟹
outstanding_refs (is_volatile_Write⇩s⇩b) sb = {} ⟹
flush sb (m(a:=v)) = (flush sb m)(a := v)"
by (induct sb)
(auto split: memref.splits if_split_asm simp add: fun_upd_twist)
lemma flush_update_other'': "⋀m. a ∉ outstanding_refs (is_non_volatile_Write⇩s⇩b) sb ⟹
a ∉ outstanding_refs (is_volatile_Write⇩s⇩b) sb ⟹
flush sb (m(a:=v)) = (flush sb m)(a := v)"
by (induct sb)
(auto split: memref.splits if_split_asm simp add: fun_upd_twist)
lemma flush_all_until_volatile_write_update_other:
"⋀m. ∀j < length ts.
(let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))
⟹
flush_all_until_volatile_write ts (m(a := v)) =
(flush_all_until_volatile_write ts m)(a := v)"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons t ts)
note notin = ‹∀j < length (t#ts).
(let (_,_,_,sb⇩j,_,_,_) = (t#ts)!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))›
hence notin': "∀j < length ts.
(let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
by auto
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where t: "t = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases t)
have no_write:
"outstanding_refs (is_volatile_Write⇩s⇩b) (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) = {}"
by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
from notin [rule_format, of 0] t
have a_notin:
"a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l)"
by (auto )
from flush_update_other' [OF a_notin no_write]
have "(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) (m(a := v))) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)(a := v)".
with Cons.hyps [OF notin', of "(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"]
show ?case
by (simp add: t del: fun_upd_apply)
qed
lemma flush_all_until_volatile_write_append_non_volatile_write_commute:
assumes no_volatile_Write⇩s⇩b: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀m i. ⟦i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,ℛ);
∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))⟧
⟹ flush_all_until_volatile_write (ts[i := (p',is', xs, sb @ [Write⇩s⇩b False a sop v A L R W],𝒟', 𝒪,ℛ')]) m =
(flush_all_until_volatile_write ts m)(a := v)"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons t ts)
note i_bound = ‹i < length (t#ts)›
note ith = ‹(t#ts)!i = (p,is,xs,sb,𝒟,𝒪,ℛ)›
note notin = ‹∀j < length (t#ts). i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = (t#ts)!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))›
show ?case
proof (cases i)
case 0
from ith 0 have t: "t = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
from no_volatile_Write⇩s⇩b have take_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from no_volatile_Write⇩s⇩b
have take_all': "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Write⇩s⇩b False a sop v A L R W]) =
(sb @ [Write⇩s⇩b False a sop v A L R W])"
by (auto simp add: outstanding_refs_conv)
from notin
have "∀j < length ts.
(let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
by (auto simp add: 0)
from flush_all_until_volatile_write_update_other [OF this]
show ?thesis
by (simp add: 0 t take_all' take_all flush_append_write del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where t: "t = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases t)
from i_bound ith notin
have "flush_all_until_volatile_write
(ts[n := (p',is',xs, sb @ [Write⇩s⇩b False a sop v A L R W], 𝒟', 𝒪,ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
(flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m))
(a := v)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc simp del: o_apply)
done
then
show ?thesis
by (simp add: t Suc del: fun_upd_apply)
qed
qed
lemma flush_all_until_volatile_write_append_unflushed:
assumes volatile_Write⇩s⇩b: "¬ outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀m i. ⟦i < length ts; ts!i = (p,is,xs,sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p',is', xs, sb @ sbx,𝒟', 𝒪,ℛ')]) m =
(flush_all_until_volatile_write ts m)"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,xs,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,xs,sb,𝒟,𝒪,ℛ)"
by simp
from volatile_Write⇩s⇩b
obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_append1 [OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)" ] volatile_r
have "(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ sbx)) m) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb ) m)"
by auto
then
show ?thesis
by (simp add: 0 l)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where l: "l = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from Cons.hyps [of n] i_bound ith
show ?thesis
by (simp add: l Suc)
qed
qed
lemma flush_all_until_volatile_nth_update_unused:
shows "⋀m i. ⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p',is',θ', sb, 𝒟', 𝒪',ℛ')]) m =
(flush_all_until_volatile_write ts m)"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
show ?thesis
by (simp add: 0 l)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from Cons.hyps [of n] i_bound ith
show ?thesis
by (simp add: l Suc)
qed
qed
lemma flush_all_until_volatile_write_append_volatile_write_commute:
assumes no_volatile_Write⇩s⇩b: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀m i. ⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧ ⟹
flush_all_until_volatile_write
(ts[i := (p',is', θ, sb @ [Write⇩s⇩b True a sop v A L R W],𝒟', 𝒪,ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
from no_volatile_Write⇩s⇩b
have s1: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from no_volatile_Write⇩s⇩b
have s2: "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Write⇩s⇩b True a sop v A L R W])) = sb"
by (auto simp add: outstanding_refs_conv)
show ?thesis
by (simp add: 0 l s1 s2)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from Cons.hyps [of n] i_bound ith
show ?thesis
by (simp add: l Suc)
qed
qed
lemma reads_consistent_update:
"⋀pending_write 𝒪 m. reads_consistent pending_write 𝒪 m sb ⟹
a ∉ outstanding_refs (Not ∘ is_volatile) sb ⟹
reads_consistent pending_write 𝒪 (m(a := v)) sb"
apply (induct sb)
apply simp
apply (clarsimp split: memref.splits if_split_asm
simp add: fun_upd_twist)
subgoal for sb 𝒪 m x11 addr val A R pending_write
apply (case_tac "a=addr")
apply simp
apply (fastforce simp add: fun_upd_twist)
done
done
lemma (in program) history_consistent_hd_prog: "⋀p. history_consistent θ p' xs
⟹ history_consistent θ (hd_prog p xs) xs"
apply (induct xs)
apply simp
apply (auto split: memref.splits option.splits)
done
locale valid_program = program +
fixes valid_prog
assumes valid_prog_inv: "⟦θ⊢p →⇩p (p',is'); valid_prog p⟧ ⟹ valid_prog p'"
lemma (in valid_program) history_consistent_appendD:
"⋀θ ys p. ∀sop ∈ write_sops xs. valid_sop sop ⟹
read_tmps xs ∩ read_tmps ys = {} ⟹
history_consistent θ p (xs@ys) ⟹
(history_consistent (θ|` (dom θ - read_tmps ys)) p xs ∧
history_consistent θ (last_prog p xs) ys ∧
read_tmps ys ∩ ⋃(fst ` write_sops xs) = {})"
proof (induct xs)
case Nil thus ?case
by auto
next
case (Cons x xs)
note valid_sops = ‹∀sop∈write_sops (x # xs). valid_sop sop›
note read_tmps_dist = ‹read_tmps (x#xs) ∩ read_tmps ys = {}›
note consis = ‹history_consistent θ p ((x#xs)@ys)›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v)
obtain D f where sop: "sop=(D,f)"
by (cases sop)
from consis obtain
D_tmps: "D ⊆ dom θ" and
f_v: "f θ = v" and
D_read_tmps: "D ∩ read_tmps (xs @ ys) = {}" and
consis': "history_consistent θ p (xs @ ys)"
by (simp add: Write⇩s⇩b sop)
from valid_sops obtain
valid_Df: "valid_sop (D,f)" and
valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Write⇩s⇩b sop)
from valid_Df
interpret valid_sop "(D,f)" .
from read_tmps_dist have read_tmps_dist': "read_tmps xs ∩ read_tmps ys = {}"
by (simp add: Write⇩s⇩b)
from D_read_tmps have D_ys: "D ∩ read_tmps ys = {}"
by (auto simp add: read_tmps_append)
with D_tmps have D_subset: "D ⊆ dom θ - read_tmps ys"
by auto
moreover
from valid_sop [OF refl D_tmps]
have "f θ = f (θ |` D)".
moreover
let ?θ' = "θ |` (dom θ - read_tmps ys)"
from D_subset
have "?θ' |` D = θ |` D"
apply -
apply (rule ext)
by (auto simp add: restrict_map_def)
moreover
from D_subset
have D_tmps': "D ⊆ dom ?θ'"
by auto
ultimately
have f_v': "f ?θ' = v"
using valid_sop [OF refl D_tmps'] f_v
by simp
from D_read_tmps
have "D ∩ read_tmps xs = {}"
by (auto simp add: read_tmps_append)
with Cons.hyps [OF valid_sops' read_tmps_dist' consis'] D_tmps D_subset f_v' D_ys
show ?thesis
by (auto simp add: Write⇩s⇩b sop)
next
case (Read⇩s⇩b volatile a t v)
from consis obtain
tmps_t: "θ t = Some v" and
consis': "history_consistent θ p (xs @ ys)"
by (simp add: Read⇩s⇩b split: option.splits)
from read_tmps_dist
obtain t_ys: "t ∉ read_tmps ys" and read_tmps_dist': "read_tmps xs ∩ read_tmps ys = {}"
by (auto simp add: Read⇩s⇩b)
from valid_sops have valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Read⇩s⇩b)
from t_ys tmps_t
have "(θ |` (dom θ - read_tmps ys)) t = Some v"
by (auto simp add: restrict_map_def domIff)
with Cons.hyps [OF valid_sops' read_tmps_dist' consis']
show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
from consis obtain p⇩1_p: "p⇩1 = p" and
prog_step: "θ |` (dom θ - read_tmps (xs @ ys))⊢ p⇩1 →⇩p (p⇩2, mis)" and
consis': "history_consistent θ p⇩2 (xs @ ys)"
by (auto simp add: Prog⇩s⇩b)
let ?θ' = "θ |` (dom θ - read_tmps ys)"
have eq: "?θ' |` (dom ?θ' - read_tmps xs) = θ |` (dom θ - read_tmps (xs @ ys))"
apply (rule ext)
apply (auto simp add: read_tmps_append restrict_map_def domIff split: if_split_asm)
done
from valid_sops have valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Prog⇩s⇩b)
from read_tmps_dist
obtain read_tmps_dist': "read_tmps xs ∩ read_tmps ys = {}"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF valid_sops' read_tmps_dist' consis'] p⇩1_p prog_step eq
show ?thesis
by (simp add: Prog⇩s⇩b)
next
case Ghost⇩s⇩b
with Cons show ?thesis
by auto
qed
qed
lemma (in valid_program) history_consistent_appendI:
"⋀θ ys p. ∀sop ∈ write_sops xs. valid_sop sop ⟹
history_consistent (θ|` (dom θ - read_tmps ys)) p xs ⟹
history_consistent θ (last_prog p xs) ys ⟹
read_tmps ys ∩ ⋃(fst ` write_sops xs) = {} ⟹ valid_prog p ⟹
history_consistent θ p (xs@ys)"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
note valid_sops = ‹∀sop∈write_sops (x # xs). valid_sop sop›
note consis_xs = ‹history_consistent (θ |` (dom θ - read_tmps ys)) p (x # xs)›
note consis_ys = ‹history_consistent θ (last_prog p (x # xs)) ys›
note dist = ‹read_tmps ys ∩ ⋃(fst ` write_sops (x # xs)) = {}›
note valid_p = ‹valid_prog p›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v)
obtain D f where sop: "sop=(D,f)"
by (cases sop)
from consis_xs obtain
D_tmps: "D ⊆ dom θ - read_tmps ys" and
f_v: "f (θ |` (dom θ - read_tmps ys)) = v" (is "f ?θ = v") and
D_read_tmps: "D ∩ read_tmps xs = {}" and
consis': "history_consistent (θ |` (dom θ - read_tmps ys)) p xs"
by (simp add: Write⇩s⇩b sop)
from D_tmps D_read_tmps
have "D ∩ read_tmps (xs @ ys) = {}"
by (auto simp add: read_tmps_append)
moreover
from D_tmps have D_tmps': "D ⊆ dom θ"
by auto
moreover
from valid_sops obtain
valid_Df: "valid_sop (D,f)" and
valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Write⇩s⇩b sop)
from valid_Df
interpret valid_sop "(D,f)" .
from D_tmps
have tmps_eq: "θ |` ((dom θ - read_tmps ys) ∩ D) = θ |` D"
apply -
apply (rule ext)
apply (auto simp add: restrict_map_def)
done
from D_tmps
have "f ?θ = f (?θ |` D)"
apply -
apply (rule valid_sop [OF refl ])
apply auto
done
with valid_sop [OF refl D_tmps'] f_v D_tmps
have "f θ = v"
by (clarsimp simp add: tmps_eq)
moreover
from consis_ys have consis_ys': "history_consistent θ (last_prog p xs) ys"
by (auto simp add: Write⇩s⇩b)
from dist have dist': "read_tmps ys ∩ ⋃(fst ` write_sops xs) = {}"
by (auto simp add: Write⇩s⇩b)
moreover note Cons.hyps [OF valid_sops' consis' consis_ys' dist' valid_p]
ultimately show ?thesis
by (simp add: Write⇩s⇩b sop)
next
case (Read⇩s⇩b volatile a t v)
from consis_xs obtain
t_v: "(θ |` (dom θ - read_tmps ys)) t = Some v" and
consis_xs': "history_consistent (θ |` (dom θ - read_tmps ys)) p xs"
by (clarsimp simp add: Read⇩s⇩b split: option.splits)
from t_v have "θ t = Some v"
by (auto simp add: restrict_map_def split: if_split_asm)
moreover
from valid_sops obtain
valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Read⇩s⇩b)
from consis_ys have consis_ys': "history_consistent θ (last_prog p xs) ys"
by (auto simp add: Read⇩s⇩b)
from dist have dist': "read_tmps ys ∩ ⋃(fst ` write_sops xs) = {}"
by (auto simp add: Read⇩s⇩b)
note Cons.hyps [OF valid_sops' consis_xs' consis_ys' dist' valid_p]
ultimately
show ?thesis
by (simp add: Read⇩s⇩b)
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
let ?θ = "θ |` (dom θ - read_tmps ys)"
from consis_xs obtain
p⇩1_p: "p⇩1 = p" and
prog_step: "?θ |` (dom ?θ - read_tmps xs)⊢ p⇩1 →⇩p (p⇩2, mis)" and
consis': "history_consistent ?θ p⇩2 xs"
by (auto simp add: Prog⇩s⇩b)
have eq: "?θ |` (dom ?θ - read_tmps xs) = θ |` (dom θ - read_tmps (xs @ ys))"
apply (rule ext)
apply (auto simp add: read_tmps_append restrict_map_def domIff split: if_split_asm)
done
from prog_step eq
have "θ |` (dom θ - read_tmps (xs @ ys))⊢ p⇩1 →⇩p (p⇩2, mis)" by simp
moreover
from valid_sops obtain
valid_sops': "∀sop∈write_sops xs. valid_sop sop"
by (auto simp add: Prog⇩s⇩b)
from consis_ys have consis_ys': "history_consistent θ (last_prog p⇩2 xs) ys"
by (auto simp add: Prog⇩s⇩b)
from dist have dist': "read_tmps ys ∩ ⋃(fst ` write_sops xs) = {}"
by (auto simp add: Prog⇩s⇩b)
note Cons.hyps [OF valid_sops' consis' consis_ys' dist' valid_prog_inv [OF prog_step valid_p [simplified p⇩1_p [symmetric]]]]
ultimately
show ?thesis
by (simp add: Prog⇩s⇩b p⇩1_p)
next
case Ghost⇩s⇩b
with Cons show ?thesis
by auto
qed
qed
lemma (in valid_program) history_consistent_append_conv:
"⋀θ ys p. ∀sop ∈ write_sops xs. valid_sop sop ⟹
read_tmps xs ∩ read_tmps ys = {} ⟹ valid_prog p ⟹
history_consistent θ p (xs@ys) =
(history_consistent (θ|` (dom θ - read_tmps ys)) p xs ∧
history_consistent θ (last_prog p xs) ys ∧
read_tmps ys ∩ ⋃(fst ` write_sops xs) = {})"
apply rule
apply (rule history_consistent_appendD,assumption+)
apply (rule history_consistent_appendI)
apply auto
done
lemma instrs_takeWhile_dropWhile_conv:
"instrs xs = instrs (takeWhile P xs) @ instrs (dropWhile P xs)"
by (induct xs) (auto split: memref.splits)
lemma (in program) history_consistent_hd_prog_p:
"⋀p. history_consistent θ p xs ⟹ p = hd_prog p xs"
by (induct xs) (auto split: memref.splits option.splits)
lemma instrs_append: "⋀ys. instrs (xs@ys) = instrs xs @ instrs ys"
by (induct xs) (auto split: memref.splits)
lemma prog_instrs_append: "⋀ys. prog_instrs (xs@ys) = prog_instrs xs @ prog_instrs ys"
by (induct xs) (auto split: memref.splits)
lemma prog_instrs_empty: "∀r ∈ set xs. ¬ is_Prog⇩s⇩b r ⟹ prog_instrs xs = []"
by (induct xs) (auto split: memref.splits)
lemma length_dropWhile [termination_simp]: "length (dropWhile P xs) ≤ length xs"
by (induct xs) auto
lemma prog_instrs_filter_is_Prog⇩s⇩b: "prog_instrs (filter (is_Prog⇩s⇩b) xs) = prog_instrs xs"
by (induct xs) (auto split: memref.splits)
lemma Cons_to_snoc: "⋀x. ∃ys y. (x#xs) = (ys@[y])"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x1 xs)
from Cons [of x1] obtain ys y where "x1#xs = ys @ [y]"
by auto
then
show ?case
by simp
qed
lemma causal_program_history_Read:
assumes causal_Read: "causal_program_history (Read volatile a t # is⇩s⇩b) sb"
shows "causal_program_history is⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v])"
proof
fix sb⇩1 sb⇩2
assume sb: "sb @ [Read⇩s⇩b volatile a t v] = sb⇩1 @ sb⇩2"
from causal_Read
interpret causal_program_history "Read volatile a t # is⇩s⇩b" "sb" .
show "∃is. instrs sb⇩2 @ is⇩s⇩b = is @ prog_instrs sb⇩2"
proof (cases sb⇩2)
case Nil
thus ?thesis
by simp
next
case (Cons r sb')
from Cons_to_snoc [of r sb'] Cons obtain ys y where sb⇩2_snoc: "sb⇩2=ys@[y]"
by auto
with sb obtain y: "y = Read⇩s⇩b volatile a t v" and sb: "sb = sb⇩1@ys"
by simp
from causal_program_history [OF sb] obtain "is" where
"instrs ys @ Read volatile a t # is⇩s⇩b = is @ prog_instrs ys"
by auto
then show ?thesis
by (simp add: sb⇩2_snoc y instrs_append prog_instrs_append)
qed
qed
lemma causal_program_history_Write:
assumes causal_Write: "causal_program_history (Write volatile a sop A L R W# is⇩s⇩b) sb"
shows "causal_program_history is⇩s⇩b (sb @ [Write⇩s⇩b volatile a sop v A L R W])"
proof
fix sb⇩1 sb⇩2
assume sb: "sb @ [Write⇩s⇩b volatile a sop v A L R W] = sb⇩1 @ sb⇩2"
from causal_Write
interpret causal_program_history "Write volatile a sop A L R W# is⇩s⇩b" "sb" .
show "∃is. instrs sb⇩2 @ is⇩s⇩b = is @ prog_instrs sb⇩2"
proof (cases sb⇩2)
case Nil
thus ?thesis
by simp
next
case (Cons r sb')
from Cons_to_snoc [of r sb'] Cons obtain ys y where sb⇩2_snoc: "sb⇩2=ys@[y]"
by auto
with sb obtain y: "y = Write⇩s⇩b volatile a sop v A L R W" and sb: "sb = sb⇩1@ys"
by simp
from causal_program_history [OF sb] obtain "is" where
"instrs ys @ Write volatile a sop A L R W# is⇩s⇩b = is @ prog_instrs ys"
by auto
then show ?thesis
by (simp add: sb⇩2_snoc y instrs_append prog_instrs_append)
qed
qed
lemma causal_program_history_Prog⇩s⇩b:
assumes causal_Write: "causal_program_history is⇩s⇩b sb"
shows "causal_program_history (is⇩s⇩b@mis) (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])"
proof
fix sb⇩1 sb⇩2
assume sb: "sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis] = sb⇩1 @ sb⇩2"
from causal_Write
interpret causal_program_history "is⇩s⇩b" "sb" .
show "∃is. instrs sb⇩2 @ (is⇩s⇩b@mis) = is @ prog_instrs sb⇩2"
proof (cases sb⇩2)
case Nil
thus ?thesis
by simp
next
case (Cons r sb')
from Cons_to_snoc [of r sb'] Cons obtain ys y where sb⇩2_snoc: "sb⇩2=ys@[y]"
by auto
with sb obtain y: "y = Prog⇩s⇩b p⇩1 p⇩2 mis" and sb: "sb = sb⇩1@ys"
by simp
from causal_program_history [OF sb] obtain "is" where
"instrs ys @ (is⇩s⇩b @ mis) = is @ prog_instrs (ys@[Prog⇩s⇩b p⇩1 p⇩2 mis])"
by (auto simp add: prog_instrs_append)
then show ?thesis
by (simp add: sb⇩2_snoc y instrs_append prog_instrs_append)
qed
qed
lemma causal_program_history_Ghost:
assumes causal_Ghost⇩s⇩b: "causal_program_history (Ghost A L R W # is⇩s⇩b) sb"
shows "causal_program_history is⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W])"
proof
fix sb⇩1 sb⇩2
assume sb: "sb @ [Ghost⇩s⇩b A L R W] = sb⇩1 @ sb⇩2"
from causal_Ghost⇩s⇩b
interpret causal_program_history "Ghost A L R W # is⇩s⇩b" "sb" .
show "∃is. instrs sb⇩2 @ is⇩s⇩b = is @ prog_instrs sb⇩2"
proof (cases sb⇩2)
case Nil
thus ?thesis
by simp
next
case (Cons r sb')
from Cons_to_snoc [of r sb'] Cons obtain ys y where sb⇩2_snoc: "sb⇩2=ys@[y]"
by auto
with sb obtain y: "y = Ghost⇩s⇩b A L R W" and sb: "sb = sb⇩1@ys"
by simp
from causal_program_history [OF sb] obtain "is" where
"instrs ys @ Ghost A L R W # is⇩s⇩b = is @ prog_instrs ys"
by auto
then show ?thesis
by (simp add: sb⇩2_snoc y instrs_append prog_instrs_append)
qed
qed
lemma hd_prog_last_prog_end: "⟦p = hd_prog p sb ; last_prog p sb = p⇩s⇩b⟧ ⟹ p = hd_prog p⇩s⇩b sb"
by (induct sb) (auto split: memref.splits)
lemma hd_prog_idem: "hd_prog (hd_prog p xs) xs = hd_prog p xs"
by (induct xs) (auto split: memref.splits)
lemma last_prog_idem: "last_prog (last_prog p sb) sb = last_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma last_prog_hd_prog_append:
"last_prog (hd_prog p⇩s⇩b (sb@sb')) sb =last_prog (hd_prog p⇩s⇩b sb') sb"
apply (induct sb)
apply (auto split: memref.splits)
done
lemma last_prog_hd_prog: "last_prog (hd_prog p xs) xs = last_prog p xs"
by (induct xs) (auto split: memref.splits)
lemma last_prog_append_Read⇩s⇩b:
"⋀p. last_prog p (sb @ [Read⇩s⇩b volatile a t v]) = last_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma last_prog_append_Write⇩s⇩b:
"⋀p. last_prog p (sb @ [Write⇩s⇩b volatile a sop v A L R W]) = last_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma last_prog_append_Prog⇩s⇩b:
"⋀x. last_prog x (sb@[Prog⇩s⇩b p p' mis]) = p'"
by (induct sb) (auto split: memref.splits)
lemma hd_prog_append_Prog⇩s⇩b: "hd_prog x (sb @ [Prog⇩s⇩b p p' mis]) = hd_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma hd_prog_last_prog_append_Prog⇩s⇩b:
"⋀p'. hd_prog p' xs = p' ⟹ last_prog p' xs = p⇩1 ⟹
hd_prog p' (xs @ [Prog⇩s⇩b p⇩1 p⇩2 mis]) = p'"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma hd_prog_append_Ghost⇩s⇩b:
"hd_prog p (sb@[Ghost⇩s⇩b A R L W]) = hd_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma last_prog_append_Ghost⇩s⇩b:
"⋀p. last_prog p (sb @ [Ghost⇩s⇩b A L R W]) = last_prog p sb"
by (induct sb) (auto split: memref.splits)
lemma dropWhile_all_False_conv:
"∀x ∈ set xs. ¬ P x ⟹ dropWhile P xs = xs"
by (induct xs) auto
lemma dropWhile_append_all_False:
"∀y ∈ set ys. ¬ P y ⟹
dropWhile P (xs@ys) = dropWhile P xs @ ys"
apply (induct xs)
apply (auto simp add: dropWhile_all_False_conv)
done
lemma reads_consistent_append_first:
"⋀m ys. reads_consistent pending_write 𝒪 m (xs @ ys) ⟹ reads_consistent pending_write 𝒪 m xs"
by (clarsimp simp add: reads_consistent_append)
lemma reads_consistent_takeWhile:
assumes consis: "reads_consistent pending_write 𝒪 m sb"
shows "reads_consistent pending_write 𝒪 m (takeWhile P sb)"
using reads_consistent_append [where xs="(takeWhile P sb)" and ys="(dropWhile P sb)"] consis
apply (simp add: reads_consistent_append)
done
lemma flush_flush_all_until_volatile_write_Write⇩s⇩b_volatile_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,xs,Write⇩s⇩b True a sop v A L R W#sb,𝒟,𝒪,ℛ);
∀i < length ts. (∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩i,_,_,_) = ts!i;
(_,_,_,sb⇩j,_,_,_) = ts!j
in outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}));
∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts!j in a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))⟧
⟹
flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
((flush_all_until_volatile_write ts m)(a := v)) =
flush_all_until_volatile_write (ts[i := (p,is,xs, sb, 𝒟', 𝒪',ℛ')])
(m(a := v))"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,xs,Write⇩s⇩b True a sop v A L R W#sb,𝒟,𝒪,ℛ)›
note disj = ‹∀i < length (l#ts). (∀j < length (l#ts). i ≠ j ⟶
(let (_,_,_,sb⇩i,_,_,_) = (l#ts)!i;
(_,_,_,sb⇩j,_,_,_) = (l#ts)!j
in outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}))›
note a_notin = ‹∀j < length (l#ts). i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = (l#ts)!j
in a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,xs,Write⇩s⇩b True a sop v A L R W#sb,𝒟,𝒪,ℛ)"
by simp
have a_notin_ts:
"a ∉ ⋃((λ(_,_,_,sb,_,_,_). outstanding_refs is_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts)" (is "a ∉ ?U")
proof
assume "a ∈ ?U"
from in_Union_image_nth_conv [OF this]
obtain j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j "xs⇩j" "sb⇩j" where
j_bound: "j < length ts" and
jth: "ts!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)" and
a_in_j: "a ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by fastforce
from a_notin [rule_format, of "Suc j"] j_bound 0 a_in_j
show False
by (auto simp add: jth)
qed
from a_notin_ts
have "(flush_all_until_volatile_write ts m)(a := v) =
flush_all_until_volatile_write ts (m(a := v))"
apply -
apply (rule update_commute' [where F="{a}" and G="?U" and
g="flush_all_until_volatile_write ts"])
apply (auto intro: flush_all_until_volatile_wirte_mem_independent
flush_all_until_volatile_write_unchanged_addresses)
done
moreover
let ?SB = "outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
have U_SB_disj: "?U ∩ ?SB = {}"
proof -
{
fix a'
assume a'_in_U: "a' ∈ ?U"
have "a' ∉ ?SB"
proof
assume a'_in_SB: "a' ∈ ?SB"
hence a'_in_SB': "a' ∈ outstanding_refs is_Write⇩s⇩b sb"
apply (clarsimp simp add: outstanding_refs_conv)
apply (drule set_takeWhileD)
subgoal for x
apply (rule_tac x=x in exI)
apply (auto simp add: is_Write⇩s⇩b_def split:memref.splits)
done
done
from in_Union_image_nth_conv [OF a'_in_U]
obtain j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j "xs⇩j" "sb⇩j" where
j_bound: "j < length ts" and
jth: "ts!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)" and
a'_in_j: "a' ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by fastforce
from disj [rule_format, of 0 "Suc j"] 0 j_bound a'_in_SB' a'_in_j jth l
show False
by auto
qed
}
moreover
{
fix a'
assume a'_in_SB: "a' ∈ ?SB"
hence a'_in_SB': "a' ∈ outstanding_refs is_Write⇩s⇩b sb"
apply (clarsimp simp add: outstanding_refs_conv)
apply (drule set_takeWhileD)
subgoal for x
apply (rule_tac x=x in exI)
apply (auto simp add: is_Write⇩s⇩b_def split:memref.splits)
done
done
have "a' ∉ ?U"
proof
assume "a' ∈ ?U"
from in_Union_image_nth_conv [OF this]
obtain j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j "xs⇩j" "sb⇩j" where
j_bound: "j < length ts" and
jth: "ts!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,ℛ⇩j,𝒪⇩j)" and
a'_in_j: "a' ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by fastforce
from disj [rule_format, of 0 "Suc j"] j_bound a'_in_SB' a'_in_j jth l
show False
by auto
qed
}
ultimately
show ?thesis by blast
qed
have "flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
(flush_all_until_volatile_write ts (m(a := v))) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (m(a := v)))"
apply (rule update_commute' [where g = "flush_all_until_volatile_write ts ",
OF _ _ _ _ U_SB_disj])
apply (auto intro: flush_all_until_volatile_wirte_mem_independent
flush_all_until_volatile_write_unchanged_addresses
flush_unchanged_addresses
flushed_values_mem_independent simp del: o_apply)
done
ultimately
have "flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
((flush_all_until_volatile_write ts m)(a := v)) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (m(a := v)))"
by simp
then show ?thesis
by (auto simp add: l 0 o_def simp del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩j xs⇩l sb⇩l where l: "l = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩j,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith disj a_notin
have
"flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
((flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m))
(a := v)) =
flush_all_until_volatile_write (ts[n := (p,is, xs, sb,𝒟', 𝒪',ℛ')])
((flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)(a := v))"
apply -
apply (rule Cons.hyps)
apply (force simp add: Suc Let_def simp del: o_apply)+
done
moreover
let ?SB = "outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l)"
have "a ∉ ?SB"
proof
assume "a ∈ ?SB"
with a_notin [rule_format, of 0]
show False
by (auto simp add: l Suc)
qed
then
have "((flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)(a := v)) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) (m(a := v)))"
apply -
apply (rule update_commute' [where m=m and F="{a}" and G="?SB"])
apply (auto intro:
flush_unchanged_addresses
flushed_values_mem_independent simp del: o_apply)
done
ultimately
show ?thesis
by (simp add: l Suc del: fun_upd_apply o_apply)
qed
qed
lemma (in program)
"⋀sb' p. history_consistent θ (hd_prog p (sb@sb')) (sb@sb') ⟹
last_prog p (sb@sb') = p ⟹
last_prog (hd_prog p (sb@sb')) sb = hd_prog p sb'"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons r sb⇩1)
have consis: "history_consistent θ (hd_prog p ((r # sb⇩1) @ sb')) ((r # sb⇩1) @ sb')"
by fact
have last_prog: "last_prog p ((r # sb⇩1) @ sb') = p" by fact
show ?case
proof (cases r)
case Write⇩s⇩b with Cons show ?thesis by auto
next
case Read⇩s⇩b with Cons show ?thesis by (auto split: option.splits)
next
case (Prog⇩s⇩b p⇩1 p⇩2 "is")
from last_prog have last_prog_p⇩2: "last_prog p⇩2 (sb⇩1 @ sb') = p"
by (simp add: Prog⇩s⇩b)
from consis obtain consis': "history_consistent θ p⇩2 (sb⇩1 @ sb')"
by (simp add: Prog⇩s⇩b)
hence "history_consistent θ (hd_prog p⇩2 (sb⇩1 @ sb')) (sb⇩1 @ sb')"
by (rule history_consistent_hd_prog)
from Cons.hyps [OF this ]
have "last_prog p⇩2 sb⇩1 = hd_prog p sb'"
oops
lemma last_prog_to_last_prog_same: "⋀p'. last_prog p' sb = p ⟹ last_prog p sb = p"
by (induct sb) (auto split: memref.splits)
lemma last_prog_hd_prog_same: "⟦last_prog p' sb = p; hd_prog p' sb = p'⟧ ⟹ hd_prog p sb = p'"
by (induct sb) (auto split : memref.splits)
lemma last_prog_hd_prog_last_prog:
"last_prog p' (sb@sb') = p ⟹ hd_prog p' (sb@sb') = p' ⟹
last_prog (hd_prog p sb') sb = last_prog p' sb"
apply (induct sb)
apply (simp add: last_prog_hd_prog_same)
apply (auto split : memref.splits)
done
lemma (in program) last_prog_hd_prog_append':
"⋀sb' p. history_consistent θ (hd_prog p (sb@sb')) (sb@sb') ⟹
last_prog p (sb@sb') = p ⟹
last_prog (hd_prog p sb') sb = hd_prog p sb'"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons r sb⇩1)
have consis: "history_consistent θ (hd_prog p ((r # sb⇩1) @ sb')) ((r # sb⇩1) @ sb')"
by fact
have last_prog: "last_prog p ((r # sb⇩1) @ sb') = p" by fact
show ?case
proof (cases r)
case Write⇩s⇩b with Cons show ?thesis by auto
next
case Read⇩s⇩b with Cons show ?thesis by (auto split: option.splits)
next
case (Prog⇩s⇩b p⇩1 p⇩2 "is")
from last_prog have last_prog_p⇩2: "last_prog p⇩2 (sb⇩1 @ sb') = p"
by (simp add: Prog⇩s⇩b)
from last_prog_to_last_prog_same [OF this]
have last_prog_p: "last_prog p (sb⇩1 @ sb') = p".
from consis obtain consis': "history_consistent θ p⇩2 (sb⇩1 @ sb')"
by (simp add: Prog⇩s⇩b)
from history_consistent_hd_prog_p [OF consis']
have hd_prog_p⇩2: "hd_prog p⇩2 (sb⇩1 @ sb') = p⇩2" by simp
from consis' have "history_consistent θ (hd_prog p (sb⇩1 @ sb')) (sb⇩1 @ sb')"
by (rule history_consistent_hd_prog)
from Cons.hyps [OF this last_prog_p]
have "last_prog (hd_prog p sb') sb⇩1 = hd_prog p sb'".
moreover
from last_prog_hd_prog_last_prog [OF last_prog_p⇩2 hd_prog_p⇩2]
have "last_prog (hd_prog p sb') sb⇩1 = last_prog p⇩2 sb⇩1".
ultimately
have "last_prog p⇩2 sb⇩1 = hd_prog p sb'"
by simp
thus ?thesis
by (simp add: Prog⇩s⇩b)
next
case Ghost⇩s⇩b with Cons show ?thesis by (auto split: option.splits)
qed
qed
lemma flush_all_until_volatile_write_Write⇩s⇩b_non_volatile_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,xs,Write⇩s⇩b False a sop v A L R W#sb,𝒟,𝒪,ℛ);
∀i < length ts. (∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩i,_,_,_) = ts!i;
(_,_,_,sb⇩j,_,_,_) = ts!j
in outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}));
∀j < length ts. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts!j in a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))⟧
⟹ flush_all_until_volatile_write (ts[i := (p,is, xs, sb,𝒟', 𝒪,ℛ')])(m(a := v)) =
flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,xs,Write⇩s⇩b False a sop v A L R W#sb,𝒟,𝒪,ℛ)›
note disj = ‹∀i < length (l#ts). (∀j < length (l#ts). i ≠ j ⟶
(let (_,_,_,sb⇩i,_,_,_) = (l#ts)!i;
(_,_,_,sb⇩j,_,_,_) = (l#ts)!j
in outstanding_refs is_Write⇩s⇩b sb⇩i ∩
outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}))›
note a_notin = ‹∀j < length (l#ts). i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = (l#ts)!j
in a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,xs,Write⇩s⇩b False a sop v A L R W#sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l xs⇩l sb⇩l where l: "l = (p⇩l,is⇩l,xs⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith disj a_notin
have
"flush_all_until_volatile_write (ts[n := (p,is,xs, sb, 𝒟', 𝒪,ℛ')])
((flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)(a := v)) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (force simp add: Suc Let_def simp del: o_apply)+
done
moreover
let ?SB = "outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l)"
have "a ∉ ?SB"
proof
assume "a ∈ ?SB"
with a_notin [rule_format, of 0]
show False
by (auto simp add: l Suc)
qed
then
have "((flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)(a := v)) =
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) (m(a := v)))"
apply -
apply (rule update_commute' [where m=m and F="{a}" and G="?SB"])
apply (auto intro:
flush_unchanged_addresses
flushed_values_mem_independent simp del: o_apply)
done
ultimately
show ?thesis
by (simp add: l Suc del: fun_upd_apply o_apply)
qed
qed
lemma (in program) history_consistent_access_last_read':
"⋀p. history_consistent θ p (sb @ [Read⇩s⇩b volatile a t v]) ⟹
θ t = Some v"
apply (induct sb)
apply (auto split: memref.splits option.splits)
done
lemma (in program) history_consistent_access_last_read:
"history_consistent θ p (rev (Read⇩s⇩b volatile a t v # sb)) ⟹ θ t = Some v"
by (simp add: history_consistent_access_last_read')
lemma flush_all_until_volatile_write_Read⇩s⇩b_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,θ,Read⇩s⇩b volatile a t v#sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p,is,θ, sb, 𝒟', 𝒪,ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,Read⇩s⇩b volatile a t v#sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,Read⇩s⇩b volatile a t v#sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write (ts[n := (p,is,θ, sb, 𝒟', 𝒪,ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then show ?thesis
by (simp add: Suc l)
qed
qed
lemma flush_all_until_volatile_write_Ghost⇩s⇩b_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,θ,Ghost⇩s⇩b A L R W#sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p',is',θ', sb, 𝒟', 𝒪',ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,Ghost⇩s⇩b A L R W#sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,Ghost⇩s⇩b A L R W#sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write (ts[n := (p',is',θ', sb, 𝒟', 𝒪',ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then show ?thesis
by (simp add: Suc l)
qed
qed
lemma flush_all_until_volatile_write_Prog⇩s⇩b_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,θ,Prog⇩s⇩b p⇩1 p⇩2 mis#sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p,is, θ, sb,𝒟', 𝒪,ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,Prog⇩s⇩b p⇩1 p⇩2 mis#sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,Prog⇩s⇩b p⇩1 p⇩2 mis#sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write (ts[n := (p,is, θ, sb,𝒟', 𝒪,ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then show ?thesis
by (simp add: Suc l)
qed
qed
lemma flush_all_until_volatile_write_append_Prog⇩s⇩b_commute:
"⋀i m. ⟦i < length ts; ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹ flush_all_until_volatile_write (ts[i := (p⇩2,is@mis, θ, sb@[Prog⇩s⇩b p⇩1 p⇩2 mis],𝒟', 𝒪,ℛ')]) m
= flush_all_until_volatile_write ts m"
proof (induct ts)
case Nil thus ?case
by simp
next
case (Cons l ts)
note i_bound = ‹i < length (l#ts)›
note ith = ‹(l#ts)!i = (p,is,θ,sb,𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 flush_append_Prog⇩s⇩b del: fun_upd_apply)
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "flush_all_until_volatile_write
(ts[n := (p⇩2,is@mis,θ, sb@[Prog⇩s⇩b p⇩1 p⇩2 mis], 𝒟', 𝒪,ℛ')])
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m) =
flush_all_until_volatile_write ts
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) m)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then show ?thesis
by (simp add: Suc l)
qed
qed
lemma (in program) history_consistent_append_Prog⇩s⇩b:
assumes step: "θ⊢ p →⇩p (p', mis)"
shows "history_consistent θ (hd_prog p xs) xs ⟹ last_prog p xs = p ⟹
history_consistent θ (hd_prog p' (xs@[Prog⇩s⇩b p p' mis])) (xs@[Prog⇩s⇩b p p' mis])"
proof (induct xs)
case Nil with step show ?case by simp
next
case (Cons x xs)
note consis = ‹history_consistent θ (hd_prog p (x # xs)) (x # xs)›
note last = ‹last_prog p (x#xs) = p›
show ?case
proof (cases x)
case Write⇩s⇩b with Cons show ?thesis by (auto simp add: read_tmps_append)
next
case Read⇩s⇩b with Cons show ?thesis by (auto split: option.splits)
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis')
from consis obtain
step: "θ |`(dom θ - read_tmps (xs @ [Prog⇩s⇩b p p' mis]))⊢ p⇩1 →⇩p (p⇩2, mis')" and
consis': "history_consistent θ p⇩2 xs"
by (auto simp add: Prog⇩s⇩b read_tmps_append)
from last have last_p⇩2: "last_prog p⇩2 xs = p"
by (simp add: Prog⇩s⇩b)
from last_prog_to_last_prog_same [OF this]
have last_prog': "last_prog p xs = p".
from history_consistent_hd_prog [OF consis']
have consis'': "history_consistent θ (hd_prog p xs) xs".
from Cons.hyps [OF this last_prog']
have "history_consistent θ (hd_prog p' (xs @ [Prog⇩s⇩b p p' mis]))
(xs @ [Prog⇩s⇩b p p' mis])".
from history_consistent_hd_prog [OF this]
have "history_consistent θ (hd_prog p⇩2 (xs @ [Prog⇩s⇩b p p' mis]))
(xs @ [Prog⇩s⇩b p p' mis])".
moreover
from history_consistent_hd_prog_p [OF consis']
have "p⇩2 = hd_prog p⇩2 xs".
from hd_prog_last_prog_append_Prog⇩s⇩b [OF this [symmetric] last_p⇩2]
have "hd_prog p⇩2 (xs @ [Prog⇩s⇩b p p' mis]) = p⇩2"
by simp
ultimately
have "history_consistent θ p⇩2 (xs @ [Prog⇩s⇩b p p' mis])"
by simp
thus ?thesis
by (simp add: Prog⇩s⇩b step)
next
case Ghost⇩s⇩b with Cons show ?thesis by (auto)
qed
qed
primrec release :: "'a memref list ⇒ addr set ⇒ rels ⇒ rels"
where
"release [] S ℛ = ℛ"
| "release (x#xs) S ℛ =
(case x of
Write⇩s⇩b volatile _ _ _ A L R W ⇒
(if volatile then release xs (S ∪ R - L) Map.empty
else release xs S ℛ)
| Ghost⇩s⇩b A L R W ⇒ release xs (S ∪ R - L) (augment_rels S R ℛ)
| _ ⇒ release xs S ℛ)"
lemma augment_rels_shared_exchange: "∀a ∈ R. (a ∈ S') = (a ∈ S) ⟹ augment_rels S R ℛ = augment_rels S' R ℛ"
apply (rule ext)
apply (auto simp add: augment_rels_def split: option.splits)
done
lemma sharing_consistent_shared_exchange:
assumes shared_eq: "∀a ∈ all_acquired sb. 𝒮' a = 𝒮 a"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "sharing_consistent 𝒮' 𝒪 sb"
using shared_eq consis
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Write⇩s⇩b True )
from shared_eq
have shared_eq': "∀a∈ all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [OF shared_eq' consis']
have "sharing_consistent (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb".
thus ?thesis
using A_shared_owns L_A A_R R_owns shared_eq
by (auto simp add: Write⇩s⇩b True domIff)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Ghost⇩s⇩b )
from shared_eq
have shared_eq': "∀a∈all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [OF shared_eq' consis']
have "sharing_consistent (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb".
thus ?thesis
using A_shared_owns L_A A_R R_owns shared_eq
by (auto simp add: Ghost⇩s⇩b domIff)
qed
qed
lemma release_shared_exchange:
assumes shared_eq: "∀a ∈ 𝒪 ∪ all_acquired sb. 𝒮' a = 𝒮 a"
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "release sb (dom 𝒮') ℛ = release sb (dom 𝒮) ℛ"
using shared_eq consis
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪 ℛ)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ 𝒪 ∪ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Write⇩s⇩b True )
from shared_eq
have shared_eq': "∀a∈𝒪 ∪ A - R ∪ all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [OF shared_eq' consis']
have "release sb (dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty = release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty" .
then show ?thesis
by (auto simp add: Write⇩s⇩b True domIff)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ 𝒪 ∪ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Ghost⇩s⇩b )
from shared_eq
have shared_eq': "∀a∈𝒪 ∪ A - R ∪ all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from A_shared_owns shared_eq R_owns have "∀a∈R. (a ∈ dom 𝒮) = (a ∈ dom 𝒮')"
by (auto simp add: domIff)
from augment_rels_shared_exchange [OF this]
have "(augment_rels (dom 𝒮') R ℛ) = (augment_rels (dom 𝒮) R ℛ)".
with Cons.hyps [OF shared_eq' consis']
have "release sb (dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮') R ℛ) =
release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮) R ℛ)" by simp
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b domIff)
qed
qed
lemma release_append:
"⋀𝒮 ℛ. release (sb@xs) (dom 𝒮) ℛ = release xs (dom (share sb 𝒮)) (release sb (dom (𝒮)) ℛ)"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "Map.empty"]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "augment_rels (dom 𝒮) R ℛ"]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
locale xvalid_program = valid_program +
fixes valid
assumes valid_implies_valid_prog:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); valid ts⟧ ⟹ valid_prog p"
assumes valid_implies_valid_prog_hd:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); valid ts⟧ ⟹ valid_prog (hd_prog p sb)"
assumes distinct_load_tmps_prog_step:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); θ⊢p →⇩p (p',is'); valid ts⟧
⟹
distinct_load_tmps is' ∧
(load_tmps is' ∩ load_tmps is = {}) ∧
(load_tmps is' ∩ read_tmps sb) = {}"
assumes valid_data_dependency_prog_step:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); θ⊢p →⇩p (p',is'); valid ts⟧
⟹
data_dependency_consistent_instrs (dom θ ∪ load_tmps is) is' ∧
load_tmps is' ∩ ⋃(fst ` store_sops is) = {} ∧
load_tmps is' ∩ ⋃(fst ` write_sops sb) = {}"
assumes load_tmps_fresh_prog_step:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); θ⊢p →⇩p (p',is'); valid ts⟧
⟹
load_tmps is' ∩ dom θ = {}"
assumes valid_sops_prog_step:
"⟦θ⊢p →⇩p (p',is'); valid_prog p⟧⟹ ∀sop∈store_sops is'. valid_sop sop"
assumes prog_step_preserves_valid:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); θ⊢p →⇩p (p',is'); valid ts⟧ ⟹
valid (ts[i:=(p',is@is',θ,sb@[Prog⇩s⇩b p p' is'],𝒟,𝒪,ℛ)])"
assumes flush_step_preserves_valid:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ); (m,sb,𝒪,ℛ,𝒮) →⇩f (m',sb',𝒪',ℛ',𝒮'); valid ts⟧ ⟹
valid (ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"
assumes sbh_step_preserves_valid:
"⟦i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮');
valid ts⟧
⟹
valid (ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"
lemma refl': "x = y ⟹ r^** x y"
by auto
lemma no_volatile_Read⇩s⇩b_volatile_reads_consistent:
"⋀m. outstanding_refs is_volatile_Read⇩s⇩b sb = {} ⟹ volatile_reads_consistent m sb"
apply (induct sb)
apply simp
subgoal for a sb m
apply (case_tac a)
apply (auto split: if_split_asm)
done
done
theorem (in program) flush_store_buffer_append:
shows "⋀ts p m θ 𝒪 ℛ 𝒟 𝒮 is 𝒪'.
⟦i < length ts;
instrs (sb@sb') @ is⇩s⇩b = is @ prog_instrs (sb@sb');
causal_program_history is⇩s⇩b (sb@sb');
ts!i = (p,is,θ |` (dom θ - read_tmps (sb@sb')),x,𝒟,𝒪,ℛ);
p=hd_prog p⇩s⇩b (sb@sb');
(last_prog p⇩s⇩b (sb@sb')) = p⇩s⇩b;
reads_consistent True 𝒪' m sb;
history_consistent θ p (sb@sb');
∀sop ∈ write_sops sb. valid_sop sop;
distinct_read_tmps (sb@sb');
volatile_reads_consistent m sb
⟧
⟹
∃is'. instrs sb' @ is⇩s⇩b = is' @ prog_instrs sb' ∧
(ts,m,𝒮) ⇒⇩d⇧*
(ts[i:=(last_prog (hd_prog p⇩s⇩b sb') sb,is',θ|` (dom θ - read_tmps sb'),x,
(𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}),
acquired True sb 𝒪, release sb (dom 𝒮) ℛ)], flush sb m,share sb 𝒮)"
proof (induct sb)
case Nil
thus ?case by (auto simp add: list_update_id' split: if_split_asm)
next
case (Cons r sb)
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb".
have ts_i:
"ts!i = (p,is,θ |` (dom θ - read_tmps ((r#sb)@sb')),x,𝒟,𝒪,ℛ)"
by fact
have "is": "instrs ((r # sb) @ sb') @ is⇩s⇩b = is @ prog_instrs ((r # sb) @ sb')" by fact
have i_bound: "i < length ts" by fact
have causal: "causal_program_history is⇩s⇩b ((r # sb) @ sb')" by fact
hence causal': "causal_program_history is⇩s⇩b (sb @ sb')"
by (auto simp add: causal_program_history_def)
note reads_consis = ‹reads_consistent True 𝒪' m (r#sb)›
note p = ‹p = hd_prog p⇩s⇩b ((r#sb)@sb')›
note p⇩s⇩b = ‹last_prog p⇩s⇩b ((r # sb) @ sb') = p⇩s⇩b›
note hist_consis = ‹history_consistent θ p ((r#sb)@sb')›
note valid_sops = ‹∀sop ∈ write_sops (r#sb). valid_sop sop›
note dist = ‹distinct_read_tmps ((r#sb)@sb')›
note vol_read_consis = ‹volatile_reads_consistent m (r#sb)›
show ?case
proof (cases r)
case (Prog⇩s⇩b p⇩1 p⇩2 pis)
from vol_read_consis
have vol_read_consis': "volatile_reads_consistent m sb"
by (auto simp add: Prog⇩s⇩b)
from hist_consis obtain
prog_step: "θ|` (dom θ - read_tmps (sb @ sb'))⊢ p⇩1 →⇩p (p⇩2, pis)" and
hist_consis': "history_consistent θ p⇩2 (sb @ sb')"
by (auto simp add: Prog⇩s⇩b)
from p obtain p: "p = p⇩1"
by (simp add: Prog⇩s⇩b)
from history_consistent_hd_prog [OF hist_consis']
have hist_consis'': "history_consistent θ (hd_prog p⇩2 (sb @ sb')) (sb @ sb')" .
from "is"
have "is": "instrs (sb @ sb') @ is⇩s⇩b = (is @ pis) @ prog_instrs (sb @ sb')"
by (simp add: Prog⇩s⇩b)
from ts_i "is" have
ts_i: "ts!i = (p, is,θ |` (dom θ - read_tmps (sb @ sb')), x, 𝒟, 𝒪,ℛ)"
by (simp add: Prog⇩s⇩b)
let ?ts'= "ts[i:=(p⇩2,is@pis,θ |` (dom θ - read_tmps (sb @ sb')), x,𝒟,𝒪,ℛ)]"
from direct_computation.Program [OF i_bound ts_i prog_step [simplified p[symmetric]]]
have "(ts,m,𝒮) ⇒⇩d (?ts',m,𝒮)" by simp
also
from i_bound have i_bound': "i < length ?ts'"
by auto
from i_bound
have ts'_i: "?ts'!i = (p⇩2,is@pis,(θ |` (dom θ - read_tmps (sb @ sb'))),x, 𝒟, 𝒪,ℛ)"
by auto
from history_consistent_hd_prog_p [OF hist_consis']
have p⇩2_hd_prog: " p⇩2 = hd_prog p⇩2 (sb @ sb')".
from reads_consis have reads_consis': "reads_consistent True 𝒪' m sb"
by (simp add: Prog⇩s⇩b)
from valid_sops have valid_sops': "∀sop ∈ write_sops sb. valid_sop sop"
by (simp add: Prog⇩s⇩b)
from dist have dist': "distinct_read_tmps (sb@sb')"
by (simp add: Prog⇩s⇩b)
from p⇩s⇩b have last_prog_p⇩2: "last_prog p⇩2 (sb @ sb') = p⇩s⇩b"
by (simp add: Prog⇩s⇩b)
from hd_prog_last_prog_end [OF p⇩2_hd_prog this]
have p⇩2_hd_prog': "p⇩2 = hd_prog p⇩s⇩b (sb @ sb')".
from last_prog_p⇩2 [symmetric] have last_prog': "last_prog p⇩s⇩b (sb @ sb') = p⇩s⇩b"
by (simp add: last_prog_idem)
from Cons.hyps [OF i_bound' "is" causal' ts'_i p⇩2_hd_prog' last_prog' reads_consis'
hist_consis' valid_sops' dist' vol_read_consis'] i_bound
obtain is' where
is': "instrs sb' @ is⇩s⇩b = is' @ prog_instrs sb'" and
step: "(?ts', m,𝒮) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b sb') sb, is',
θ |` (dom θ - read_tmps sb'), x, 𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {},
acquired True sb 𝒪,release sb (dom 𝒮) ℛ)],
flush sb m,share sb 𝒮 )"
by (auto)
from p⇩2_hd_prog'
have last_prog_eq: "last_prog (hd_prog p⇩s⇩b sb') sb = last_prog p⇩2 sb"
by (simp add: last_prog_hd_prog_append)
note step
finally show ?thesis
using is'
by (simp add: Prog⇩s⇩b last_prog_eq)
next
case (Write⇩s⇩b volatile a sop v A L R W)
obtain D f where sop: "sop=(D,f)"
by (cases sop)
from vol_read_consis
have vol_read_consis': "volatile_reads_consistent (m(a:=v)) sb"
by (auto simp add: Write⇩s⇩b)
from hist_consis obtain
D_tmps: "D ⊆ dom θ" and
f_v: "f θ = v" and
dep: "D ∩ read_tmps (sb@sb') = {}" and
hist_consis': "history_consistent θ p (sb@sb')"
by (simp add: Write⇩s⇩b sop split: option.splits)
from dist have dist': "distinct_read_tmps (sb@sb')" by (auto simp add: Write⇩s⇩b)
from valid_sops obtain "valid_sop sop" and
valid_sops': "∀sop ∈ write_sops sb. valid_sop sop"
by (simp add: Write⇩s⇩b)
interpret valid_sop sop by fact
from valid_sop [OF sop D_tmps]
have "f θ = f (θ |` D)" .
moreover
from dep D_tmps have D_subset: "D ⊆ (dom θ - read_tmps (sb@sb'))"
by auto
moreover from D_subset have "(θ|`(dom θ - read_tmps (sb@sb')) |` D) = θ |` D"
apply -
apply (rule ext)
apply (auto simp add: restrict_map_def)
done
moreover from D_subset D_tmps have "D ⊆ dom (θ |` (dom θ - read_tmps (sb@sb')))"
by simp
moreover
note valid_sop [OF sop this]
ultimately have f_v': "f (θ|`(dom θ - read_tmps (sb@sb'))) = v"
by (simp add: f_v)
interpret causal': causal_program_history "is⇩s⇩b" "sb@sb'" by fact
from "is"
have "Write volatile a sop A L R W# instrs (sb @ sb') @ is⇩s⇩b = is @ prog_instrs (sb @ sb')"
by (simp add: Write⇩s⇩b)
with causal'.causal_program_history [of "[]", simplified, OF refl]
obtain is' where "is": "is=Write volatile a sop A L R W#is'" and
is': "instrs (sb @ sb') @ is⇩s⇩b = is' @ prog_instrs (sb @ sb')"
by auto
from ts_i "is"
have ts_i: "ts!i = (p,Write volatile a sop A L R W#is',
θ |` (dom θ - read_tmps (sb@sb')),x,𝒟,𝒪,ℛ)"
by (simp add: Write⇩s⇩b)
from p have p': "p = hd_prog p⇩s⇩b (sb@sb')"
by (auto simp add: Write⇩s⇩b hd_prog_idem)
from p⇩s⇩b have p⇩s⇩b': "last_prog p⇩s⇩b (sb @ sb') = p⇩s⇩b"
by (simp add: Write⇩s⇩b)
show ?thesis
proof (cases volatile)
case False
have memop_step:
"(Write volatile a sop A L R W#is',θ|`(dom θ - read_tmps (sb@sb')),
x,m,𝒟,𝒪,ℛ,𝒮) →
(is',θ|` (dom θ - read_tmps (sb@sb')),x,m(a:=v),𝒟,𝒪,ℛ,𝒮)"
using D_subset
apply (simp only: sop f_v' [symmetric] False)
apply (rule direct_memop_step.WriteNonVolatile)
done
let ?ts' = "ts[i := (p, is',θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪,ℛ)]"
from direct_computation.Memop [OF i_bound ts_i memop_step]
have "(ts, m, 𝒮) ⇒⇩d (?ts', m(a := v), 𝒮)".
also
from reads_consis have reads_consis': "reads_consistent True 𝒪' (m(a:=v)) sb"
by (auto simp add: Write⇩s⇩b False)
from i_bound have i_bound': "i < length ?ts'"
by auto
from i_bound
have ts'_i: "?ts' ! i = (p, is',θ |` (dom θ - read_tmps (sb @ sb')), x, 𝒟, 𝒪,ℛ)"
by simp
from Cons.hyps [OF i_bound' is' causal' ts'_i p' p⇩s⇩b' reads_consis' hist_consis'
valid_sops' dist' vol_read_consis'] i_bound
obtain is'' where
is'': "instrs sb' @ is⇩s⇩b = is'' @ prog_instrs sb'" and
steps: "(?ts',m(a:=v),𝒮) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b sb') sb, is'',
θ |` (dom θ - read_tmps sb'), x,
𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}, acquired True sb 𝒪, release sb (dom 𝒮) ℛ)],
flush sb (m(a := v)),share sb 𝒮)"
by (auto simp del: fun_upd_apply)
note steps
finally
show ?thesis
using is''
by (simp add: Write⇩s⇩b False)
next
case True
have memop_step:
"(Write volatile a sop A L R W#is',θ|`(dom θ - read_tmps (sb@sb')),
x,m,𝒟,𝒪,ℛ,𝒮 ) →
(is',θ|` (dom θ - read_tmps (sb@sb')),x,m(a:=v),True,𝒪 ∪ A - R,Map.empty,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
using D_subset
apply (simp only: sop f_v' [symmetric] True)
apply (rule direct_memop_step.WriteVolatile)
done
let ?ts' = "ts[i := (p, is', θ |` (dom θ - read_tmps (sb @ sb')),x, True, 𝒪 ∪ A - R,Map.empty)]"
from direct_computation.Memop [OF i_bound ts_i memop_step]
have "(ts, m, 𝒮) ⇒⇩d (?ts', m(a := v), 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
also
from reads_consis have reads_consis': "reads_consistent True (𝒪' ∪ A - R)(m(a:=v)) sb"
by (auto simp add: Write⇩s⇩b True)
from i_bound have i_bound': "i < length ?ts'"
by auto
from i_bound
have ts'_i: "?ts' ! i = (p, is',θ |` (dom θ - read_tmps (sb @ sb')), x, True, 𝒪 ∪ A - R,Map.empty)"
by simp
from Cons.hyps [OF i_bound' is' causal' ts'_i p' p⇩s⇩b' reads_consis' hist_consis'
valid_sops' dist' vol_read_consis', of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"] i_bound
obtain is'' where
is'': "instrs sb' @ is⇩s⇩b = is'' @ prog_instrs sb'" and
steps: "(?ts',m(a:=v),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b sb') sb, is'',
θ |` (dom θ - read_tmps sb'), x,
True, acquired True sb (𝒪 ∪ A - R),release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty)],
flush sb (m(a := v)), share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (auto simp del: fun_upd_apply)
note steps
finally
show ?thesis
using is''
by (simp add: Write⇩s⇩b True)
qed
next
case (Read⇩s⇩b volatile a t v)
from vol_read_consis reads_consis obtain v: "v=m a" and r_consis: "reads_consistent True 𝒪' m sb" and
vol_read_consis': "volatile_reads_consistent m sb"
by (cases volatile) (auto simp add: Read⇩s⇩b)
from valid_sops have valid_sops': "∀sop ∈ write_sops sb. valid_sop sop"
by (simp add: Read⇩s⇩b)
from hist_consis obtain θ: "θ t = Some v" and
hist_consis': "history_consistent θ p (sb@sb')"
by (simp add: Read⇩s⇩b split: option.splits)
from dist obtain t_notin: "t ∉ read_tmps (sb@sb')" and
dist': "distinct_read_tmps (sb@sb')" by (simp add: Read⇩s⇩b)
from θ t_notin have restrict_commute:
"(θ|` (dom θ - read_tmps (sb@sb')))(t↦v) =
θ|` (dom θ - read_tmps (sb@sb'))"
apply -
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
from θ t_notin
have restrict_commute':
"((θ |` (dom θ - insert t (read_tmps (sb@sb'))))(t ↦ v)) =
θ|` (dom θ - read_tmps (sb@sb'))"
apply -
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
interpret causal': causal_program_history "is⇩s⇩b" "sb@sb'" by fact
from "is"
have "Read volatile a t # instrs (sb @ sb') @ is⇩s⇩b = is @ prog_instrs (sb @ sb')"
by (simp add: Read⇩s⇩b)
with causal'.causal_program_history [of "[]", simplified, OF refl]
obtain is' where "is": "is=Read volatile a t#is'" and
is': "instrs (sb @ sb') @ is⇩s⇩b = is' @ prog_instrs (sb @ sb')"
by auto
from ts_i "is"
have ts_i: "ts!i = (p,Read volatile a t#is',
θ |` (dom θ - insert t (read_tmps (sb@sb'))),x,𝒟,𝒪,ℛ)"
by (simp add: Read⇩s⇩b)
from direct_memop_step.Read [of volatile a t "is'" "θ|` (dom θ - insert t (read_tmps (sb@sb')))" x m 𝒟 𝒪 ℛ 𝒮]
have memop_step: "
(Read volatile a t # is',
θ |` (dom θ - insert t (read_tmps (sb @ sb'))), x, m, 𝒟, 𝒪,ℛ,𝒮) →
(is',
θ |` (dom θ - (read_tmps (sb @ sb'))), x, m, 𝒟, 𝒪, ℛ,𝒮)"
by (simp add: v [symmetric] restrict_commute restrict_commute')
let ?ts' = "ts[i := (p, is',
θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪,ℛ)]"
from direct_computation.Memop [OF i_bound ts_i memop_step]
have "(ts, m, 𝒮) ⇒⇩d (?ts', m, 𝒮)".
also
from i_bound have i_bound': "i < length ?ts'"
by auto
from i_bound
have ts'_i: "?ts'!i = (p,is', (θ |` (dom θ - read_tmps (sb @ sb'))),x,𝒟, 𝒪, ℛ)"
by auto
from p have p': "p = hd_prog p⇩s⇩b (sb@sb')"
by (auto simp add: Read⇩s⇩b hd_prog_idem)
from p⇩s⇩b have p⇩s⇩b': "last_prog p⇩s⇩b (sb @ sb') = p⇩s⇩b"
by (simp add: Read⇩s⇩b)
from Cons.hyps [OF i_bound' is' causal' ts'_i p' p⇩s⇩b' r_consis hist_consis'
valid_sops' dist' vol_read_consis']
obtain is'' where
is'': "instrs sb' @ is⇩s⇩b = is'' @ prog_instrs sb'" and
steps: "(?ts',m,𝒮) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b sb') sb, is'',
θ |` (dom θ - read_tmps sb'),x, 𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {},
acquired True sb 𝒪, release sb (dom 𝒮) ℛ)],
flush sb m,share sb 𝒮)"
by (auto simp del: fun_upd_apply)
note steps
finally
show ?thesis
using is''
by (simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from vol_read_consis
have vol_read_consis': "volatile_reads_consistent m sb"
by (auto simp add: Ghost⇩s⇩b)
from reads_consis have r_consis: "reads_consistent True (𝒪' ∪ A - R) m sb"
by (auto simp add: Ghost⇩s⇩b)
from valid_sops have valid_sops': "∀sop ∈ write_sops sb. valid_sop sop"
by (simp add: Ghost⇩s⇩b)
from hist_consis obtain
hist_consis': "history_consistent θ p (sb@sb')"
by (simp add: Ghost⇩s⇩b)
from dist obtain
dist': "distinct_read_tmps (sb@sb')" by (simp add: Ghost⇩s⇩b)
interpret causal': causal_program_history "is⇩s⇩b" "sb@sb'" by fact
from "is"
have "Ghost A L R W# instrs (sb @ sb') @ is⇩s⇩b = is @ prog_instrs (sb @ sb')"
by (simp add: Ghost⇩s⇩b)
with causal'.causal_program_history [of "[]", simplified, OF refl]
obtain is' where "is": "is=Ghost A L R W#is'" and
is': "instrs (sb @ sb') @ is⇩s⇩b = is' @ prog_instrs (sb @ sb')"
by auto
from ts_i "is"
have ts_i: "ts!i = (p,Ghost A L R W#is',
θ |` (dom θ - (read_tmps (sb@sb'))),x,𝒟,𝒪,ℛ)"
by (simp add: Ghost⇩s⇩b)
from direct_memop_step.Ghost [of A L R W "is'"
"θ|` (dom θ - (read_tmps (sb@sb')))" x m 𝒟 "𝒪" ℛ 𝒮]
have memop_step:"
(Ghost A L R W# is',θ |` (dom θ - read_tmps (sb @ sb')), x, m, 𝒟, 𝒪, ℛ, 𝒮)
→ (is',θ |` (dom θ - read_tmps (sb @ sb')), x, m, 𝒟, 𝒪 ∪ A - R , augment_rels (dom 𝒮) R ℛ,
𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
let ?ts' = "ts[i := (p, is',
θ |` (dom θ - read_tmps (sb @ sb')),x, 𝒟, 𝒪 ∪ A - R, augment_rels (dom 𝒮) R ℛ)]"
from direct_computation.Memop [OF i_bound ts_i memop_step]
have "(ts, m, 𝒮) ⇒⇩d (?ts', m, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
also
from i_bound have i_bound': "i < length ?ts'"
by auto
from i_bound
have ts'_i: "?ts'!i = (p,is',(θ |` (dom θ - read_tmps (sb @ sb'))),x, 𝒟, 𝒪 ∪ A - R,augment_rels (dom 𝒮) R ℛ )"
by auto
from p have p': "p = hd_prog p⇩s⇩b (sb@sb')"
by (auto simp add: Ghost⇩s⇩b hd_prog_idem)
from p⇩s⇩b have p⇩s⇩b': "last_prog p⇩s⇩b (sb @ sb') = p⇩s⇩b"
by (simp add: Ghost⇩s⇩b)
from Cons.hyps [OF i_bound' is' causal' ts'_i p' p⇩s⇩b' r_consis hist_consis'
valid_sops' dist' vol_read_consis', of "𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"]
obtain is'' where
is'': "instrs sb' @ is⇩s⇩b = is'' @ prog_instrs sb'" and
steps: "(?ts',m,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b sb') sb, is'',
θ |` (dom θ - read_tmps sb'),x,
𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}, acquired True sb (𝒪 ∪ A - R),
release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮) R ℛ))],
flush sb m,share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (auto simp add: list_update_overwrite simp del: fun_upd_apply)
note steps
finally
show ?thesis
using is''
by (simp add: Ghost⇩s⇩b)
qed
qed
corollary (in program) flush_store_buffer:
assumes i_bound: "i < length ts"
assumes instrs: "instrs sb @ is⇩s⇩b = is @ prog_instrs sb"
assumes cph: "causal_program_history is⇩s⇩b sb"
assumes ts_i: "ts!i = (p,is,θ |` (dom θ - read_tmps sb),x,𝒟,𝒪,ℛ)"
assumes p: "p=hd_prog p⇩s⇩b sb"
assumes last_prog: "(last_prog p⇩s⇩b sb) = p⇩s⇩b"
assumes reads_consis: "reads_consistent True 𝒪' m sb"
assumes hist_consis: "history_consistent θ p sb"
assumes valid_sops: "∀sop ∈ write_sops sb. valid_sop sop"
assumes dist: "distinct_read_tmps sb"
assumes vol_read_consis: "volatile_reads_consistent m sb"
shows "(ts,m,𝒮) ⇒⇩d⇧*
(ts[i:=(p⇩s⇩b,is⇩s⇩b, θ,x,
𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {},acquired True sb 𝒪, release sb (dom 𝒮) ℛ)],
flush sb m,share sb 𝒮)"
using flush_store_buffer_append [where sb'="[]", simplified, OF i_bound instrs cph ts_i [simplified] p last_prog reads_consis hist_consis valid_sops dist vol_read_consis] last_prog
by simp
lemma last_prog_same_append: "⋀xs p⇩s⇩b. last_prog p⇩s⇩b (sb@xs) = p⇩s⇩b ⟹ last_prog p⇩s⇩b xs = p⇩s⇩b"
apply (induct sb)
apply simp
subgoal for a sb xs p⇩s⇩b
apply (case_tac a)
apply simp
apply simp
apply simp
apply (drule last_prog_to_last_prog_same)
apply simp
apply simp
done
done
lemma reads_consistent_drop_volatile_writes_no_volatile_reads:
"⋀pending_write 𝒪 m. reads_consistent pending_write 𝒪 m sb ⟹
outstanding_refs is_volatile_Read⇩s⇩b ((dropWhile (Not ∘ is_volatile_Write⇩s⇩b)) sb) = {}"
apply (induct sb)
apply (auto split: memref.splits)
done
lemma reads_consistent_flush_other:
assumes no_volatile_Write⇩s⇩b_sb: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀m pending_write 𝒪.
⟦outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩ outstanding_refs is_non_volatile_Write⇩s⇩b sb = {};
reads_consistent pending_write 𝒪 m xs⟧ ⟹ reads_consistent pending_write 𝒪 (flush sb m) xs"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
note no_inter = ‹outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (x # xs) ∩
outstanding_refs is_non_volatile_Write⇩s⇩b sb = {}›
hence no_inter': "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩ outstanding_refs is_non_volatile_Write⇩s⇩b sb = {}"
by (auto)
note consis = ‹reads_consistent pending_write 𝒪 m (x # xs)›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R)
show ?thesis
proof (cases volatile)
case False
from consis obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) xs"
by (simp add: Write⇩s⇩b False)
from Cons.hyps [OF no_inter' consis']
have "reads_consistent pending_write 𝒪 (flush sb (m(a := v))) xs".
moreover
from no_inter have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (auto simp add: Write⇩s⇩b split: if_split_asm)
from flush_update_other' [OF this no_volatile_Write⇩s⇩b_sb]
have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
ultimately
show ?thesis
by (simp add: Write⇩s⇩b False)
next
case True
from consis obtain consis': "reads_consistent True (𝒪 ∪ A - R) (m(a := v)) xs" and
no_read: "(outstanding_refs is_volatile_Read⇩s⇩b xs = {} )"
by (simp add: Write⇩s⇩b True)
from Cons.hyps [OF no_inter' consis']
have "reads_consistent True (𝒪 ∪ A - R) (flush sb (m(a := v))) xs".
moreover
from no_inter have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (auto simp add: Write⇩s⇩b split: if_split_asm)
from flush_update_other' [OF this no_volatile_Write⇩s⇩b_sb]
have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
ultimately
show ?thesis
using no_read
by (simp add: Write⇩s⇩b True)
qed
next
case (Read⇩s⇩b volatile a t v)
from consis obtain val: "(¬ volatile ⟶ (pending_write ∨ a ∈ 𝒪) ⟶ v = m a)" and
consis': "reads_consistent pending_write 𝒪 m xs"
by (simp add: Read⇩s⇩b)
from Cons.hyps [OF no_inter' consis']
have hyp: "reads_consistent pending_write 𝒪 (flush sb m) xs"
by simp
show ?thesis
proof (cases volatile)
case False
from no_inter False have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
with no_volatile_Write⇩s⇩b_sb
have "a ∉ outstanding_refs is_Write⇩s⇩b sb"
apply (clarsimp simp add: outstanding_refs_conv is_Write⇩s⇩b_def split: memref.splits)
apply force
done
with hyp val flush_unchanged_addresses [OF this]
show ?thesis
by (simp add: Read⇩s⇩b)
next
case True
with hyp val show ?thesis
by (simp add: Read⇩s⇩b)
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case Ghost⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma reads_consistent_flush_independent:
assumes no_volatile_Write⇩s⇩b_sb: "outstanding_refs is_Write⇩s⇩b sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b xs = {}"
assumes consis: "reads_consistent pending_write 𝒪 m xs"
shows "reads_consistent pending_write 𝒪 (flush sb m) xs"
proof -
from flush_unchanged_addresses [where sb=sb and m=m] no_volatile_Write⇩s⇩b_sb
have "∀a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b xs. flush sb m a = m a"
by auto
from reads_consistent_mem_eq_on_non_volatile_reads [OF this subset_refl consis]
show ?thesis .
qed
lemma reads_consistent_flush_all_until_volatile_write_aux:
assumes no_reads: "outstanding_refs is_volatile_Read⇩s⇩b xs = {}"
shows "⋀m pending_write 𝒪'. ⟦reads_consistent pending_write 𝒪' m xs; ∀i < length ts.
let (p,is,θ,sb,𝒟,𝒪,ℛ) = ts!i in
outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = {}⟧
⟹ reads_consistent pending_write 𝒪' (flush_all_until_volatile_write ts m) xs"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
have consis: "reads_consistent pending_write 𝒪' m xs" by fact
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t
where t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
from Cons.prems t obtain
no_inter: "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) = {}" and
no_inter': "∀i < length ts.
let (p,is,θ,sb,𝒟,𝒪,ℛ) = ts!i in
outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = {}"
by (force simp add: Let_def simp del: o_apply)
have out1: "outstanding_refs is_volatile_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) = {}"
by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
from no_inter have "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs ∩
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) = {}"
by auto
from reads_consistent_flush_other [OF out1 this consis]
have "reads_consistent pending_write 𝒪' (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) m) xs".
from Cons.hyps [OF this no_inter']
show ?case
by (simp add: t)
qed
lemma reads_consistent_flush_other':
assumes no_volatile_Write⇩s⇩b_sb: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀m 𝒪.
⟦outstanding_refs is_non_volatile_Write⇩s⇩b sb ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
) = {};
reads_consistent False 𝒪 m xs;
read_only_reads 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ⊆ RO⟧
⟹ reads_consistent False 𝒪 (flush sb m) xs"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
note no_inter = Cons.prems (1)
note consis = ‹reads_consistent False 𝒪 m (x # xs)›
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
note RO = ‹read_only_reads 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (x#xs)) ⊆ RO›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R)
show ?thesis
proof (cases volatile)
case False
from consis obtain consis': "reads_consistent False 𝒪 (m(a := v)) xs"
by (simp add: Write⇩s⇩b False)
from no_inter
have no_inter': "outstanding_refs is_non_volatile_Write⇩s⇩b sb ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
) = {}"
by (clarsimp simp add: Write⇩s⇩b False aargh)
from RO
have RO': "read_only_reads 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ⊆ RO"
by (auto simp add: Write⇩s⇩b False)
from Cons.hyps [OF no_inter' consis' RO']
have "reads_consistent False 𝒪 (flush sb (m(a := v))) xs".
moreover
from no_inter have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (auto simp add: Write⇩s⇩b split: if_split_asm)
from flush_update_other' [OF this no_volatile_Write⇩s⇩b_sb]
have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
ultimately
show ?thesis
by (simp add: Write⇩s⇩b False)
next
case True
from consis obtain consis': "reads_consistent True (𝒪 ∪ A - R) (m(a := v)) xs" and
no_read: "(outstanding_refs is_volatile_Read⇩s⇩b xs = {})"
by (simp add: Write⇩s⇩b True)
from no_inter obtain
a_notin: "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb" and
disj: "(outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) xs) ∩
outstanding_refs is_non_volatile_Write⇩s⇩b sb = {}"
by (auto simp add: Write⇩s⇩b True aargh misc_outstanding_refs_convs)
from reads_consistent_flush_other [OF no_volatile_Write⇩s⇩b_sb disj consis']
have "reads_consistent True (𝒪 ∪ A - R) (flush sb (m(a := v))) xs".
moreover
note a_notin
from flush_update_other' [OF this no_volatile_Write⇩s⇩b_sb]
have "(flush sb (m(a := v))) = (flush sb m)(a := v)".
ultimately
show ?thesis
using no_read
by (simp add: Write⇩s⇩b True)
qed
next
case (Read⇩s⇩b volatile a t v)
from consis obtain val: "(¬ volatile ⟶ a ∈ 𝒪 ⟶ v = m a)" and
consis': "reads_consistent False 𝒪 m xs"
by (simp add: Read⇩s⇩b)
from RO
have RO': "read_only_reads 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ⊆ RO"
by (auto simp add: Read⇩s⇩b )
from no_inter
have no_inter': "outstanding_refs is_non_volatile_Write⇩s⇩b sb ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
) = {}"
by (fastforce simp add: Read⇩s⇩b aargh)
show ?thesis
proof (cases volatile)
case True
from Cons.hyps [OF no_inter' consis' RO']
show ?thesis
by (simp add: Read⇩s⇩b True)
next
case False
note non_volatile=this
from Cons.hyps [OF no_inter' consis' RO']
have hyp: "reads_consistent False 𝒪 (flush sb m) xs".
show ?thesis
proof (cases "a ∈ 𝒪")
case False
with hyp show ?thesis
by (simp add: Read⇩s⇩b non_volatile False)
next
case True
from no_inter True have a_notin: "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by blast
with no_volatile_Write⇩s⇩b_sb
have "a ∉ outstanding_refs is_Write⇩s⇩b sb"
apply (clarsimp simp add: outstanding_refs_conv is_Write⇩s⇩b_def split: memref.splits)
apply force
done
from flush_unchanged_addresses [OF this] hyp val
show ?thesis
by (simp add: Read⇩s⇩b non_volatile True)
qed
qed
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from consis obtain consis': "reads_consistent False (𝒪 ∪ A - R) m xs"
by (simp add: Ghost⇩s⇩b)
from RO
have RO': "read_only_reads (𝒪 ∪ A - R) (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ⊆ RO"
by (auto simp add: Ghost⇩s⇩b)
from no_inter
have no_inter': "outstanding_refs is_non_volatile_Write⇩s⇩b sb ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪 ∪ A - R ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
) = {}"
by (fastforce simp add: Ghost⇩s⇩b aargh)
from Cons.hyps [OF no_inter' consis' RO' ]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma reads_consistent_flush_all_until_volatile_write_aux':
assumes no_reads: "outstanding_refs is_volatile_Read⇩s⇩b xs = {}"
assumes read_only_reads_RO: "read_only_reads 𝒪' (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ⊆ RO"
shows "⋀m. ⟦reads_consistent False 𝒪' m xs; ∀i < length ts.
let (p,is,θ,sb,𝒟,𝒪) = ts!i in
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪' ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
)
= {}
⟧
⟹ reads_consistent False 𝒪' (flush_all_until_volatile_write ts m) xs"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
have consis: "reads_consistent False 𝒪' m xs" by fact
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t
where t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
obtain
no_inter: "outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪' ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
)
= {}" and
no_inter': "∀i < length ts.
let (p,is,θ,sb,𝒟,𝒪) = ts!i in
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Write⇩s⇩b xs ∪
outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) ∪
(outstanding_refs is_non_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs) - RO) ∪
(𝒪' ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) xs))
)
= {}"
proof -
show ?thesis
apply (rule that)
using Cons.prems (2) [rule_format, of 0]
apply (clarsimp simp add: t)
apply clarsimp
using Cons.prems (2)
apply -
subgoal for i
apply (drule_tac x="Suc i" in spec)
apply (clarsimp simp add: Let_def simp del: o_apply)
done
done
qed
have out1: "outstanding_refs is_volatile_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) = {}"
by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
from reads_consistent_flush_other' [OF out1 no_inter consis read_only_reads_RO ]
have "reads_consistent False 𝒪' (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) m) xs".
from Cons.hyps [OF this no_inter']
show ?case
by (simp add: t)
qed
lemma in_outstanding_refs_cases [consumes 1, case_names Write⇩s⇩b Read⇩s⇩b]:
"a ∈ outstanding_refs P xs ⟹
(⋀volatile sop v A L R W. (Write⇩s⇩b volatile a sop v A L R W) ∈ set xs ⟹ P (Write⇩s⇩b volatile a sop v A L R W) ⟹ C) ⟹
(⋀volatile t v. (Read⇩s⇩b volatile a t v) ∈ set xs ⟹ P (Read⇩s⇩b volatile a t v) ⟹ C)
⟹ C"
apply (clarsimp simp add: outstanding_refs_conv)
subgoal for x
apply (case_tac x)
apply fastforce+
done
done
lemma dropWhile_Cons: "(dropWhile P xs) = x#ys ⟹ ¬ P x"
apply (induct xs)
apply (auto split: if_split_asm)
done
lemma reads_consistent_dropWhile:
"reads_consistent pending_write 𝒪 m (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) =
reads_consistent True 𝒪 m (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (case_tac "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)")
apply (simp only:)
apply simp
apply (frule dropWhile_Cons)
apply (auto split: memref.splits)
done
theorem
reads_consistent_flush_all_until_volatile_write:
"⋀i m pending_write. ⟦valid_ownership_and_sharing 𝒮 ts;
i < length ts; ts!i = (p, is,θ, sb, 𝒟, 𝒪,ℛ);
reads_consistent pending_write 𝒪 m sb ⟧
⟹ reads_consistent True (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(flush_all_until_volatile_write ts m) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
note i_bound = ‹i < length (t # ts)›
note ts_i = ‹(t # ts) ! i = (p, is,θ, sb, 𝒟, 𝒪,ℛ)›
note consis = ‹reads_consistent pending_write 𝒪 m sb›
note valid = ‹valid_ownership_and_sharing 𝒮 (t#ts)›
then interpret valid_ownership_and_sharing 𝒮 "t#ts".
from valid_ownership_and_sharing_tl [OF valid] have valid': "valid_ownership_and_sharing 𝒮 ts".
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t
where t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
show ?case
proof (cases i)
case 0
with ts_i t have sb_eq: "sb=sb⇩t"
by simp
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from reads_consistent_append [of pending_write 𝒪 m ?take_sb ?drop_sb] consis
have consis': "reads_consistent True (acquired True ?take_sb 𝒪) (flush ?take_sb m) ?drop_sb"
apply (cases "outstanding_refs is_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ≠ {}")
apply clarsimp
apply clarsimp
apply (simp add: reads_consistent_dropWhile [of pending_write])
done
from reads_consistent_drop_volatile_writes_no_volatile_reads [OF consis]
have no_vol_Read⇩s⇩b: "outstanding_refs is_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = {}".
hence "outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
=
outstanding_refs (λs. True) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: outstanding_refs_conv)
have "∀i<length ts.
let (p, is,θ, sb', 𝒟, 𝒪,ℛ) = ts ! i
in outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩
outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = {}"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts"
assume ts_j: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_in_sb: "x ∈ outstanding_refs (Not ∘ is_volatile_Read⇩s⇩b) (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
assume x_in_j: "x ∈ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
have False
proof -
from outstanding_non_volatile_write_not_volatile_read_disj [rule_format, of "Suc j" 0, simplified, OF j_bound ts_j t]
sb_eq x_in_sb x_in_j
show ?thesis
by auto
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
from reads_consistent_flush_all_until_volatile_write_aux [OF no_vol_Read⇩s⇩b consis' this]
show ?thesis
by (simp add: t sb_eq del: o_apply)
next
case (Suc k)
with i_bound have k_bound: "k < length ts"
by auto
from ts_i Suc have ts_k: "ts ! k = (p, is,θ, sb, 𝒟, 𝒪,ℛ)"
by simp
have "reads_consistent False 𝒪 (flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) m) sb"
proof -
have no_vW:
"outstanding_refs is_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) = {}"
apply (clarsimp simp add: outstanding_refs_conv )
apply (drule set_takeWhileD)
apply simp
done
from consis have consis': "reads_consistent False 𝒪 m sb"
by (cases pending_write) (auto intro: reads_consistent_pending_write_antimono)
note disj = outstanding_non_volatile_write_disj [where i=0, OF _ i_bound [simplified Suc], simplified, OF t ts_k ]
from reads_consistent_flush_other' [OF no_vW disj consis' subset_refl]
show ?thesis .
qed
from Cons.hyps [OF valid' k_bound ts_k this]
show ?thesis
by (simp add: t)
qed
qed
lemma split_volatile_Write⇩s⇩b_in_outstanding_refs:
"a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs ⟹ (∃sop v ys zs A L R W. xs = ys@(Write⇩s⇩b True a sop v A L R W#zs))"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
have a_in: "a ∈ outstanding_refs is_volatile_Write⇩s⇩b (x # xs)" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
from a_in have "a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (auto simp add: False Write⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case True
note volatile = this
show ?thesis
proof (cases "a'=a")
case False
with a_in have "a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (auto simp add: volatile Write⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case True
then have "x#xs=[]@(Write⇩s⇩b True a sop v A L R W#xs)"
by (simp add: Write⇩s⇩b volatile True)
thus ?thesis
by blast
qed
qed
next
case Read⇩s⇩b
from a_in have "a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (auto simp add: Read⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case Prog⇩s⇩b
from a_in have "a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case Ghost⇩s⇩b
from a_in have "a ∈ outstanding_refs is_volatile_Write⇩s⇩b xs"
by (auto simp add: Ghost⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
qed
qed
lemma sharing_consistent_mono_shared:
"⋀𝒮 𝒮' 𝒪.
dom 𝒮 ⊆ dom 𝒮' ⟹ sharing_consistent 𝒮 𝒪 sb ⟹ sharing_consistent 𝒮' 𝒪 sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒮 𝒮' 𝒪
apply (case_tac a)
apply clarsimp
subgoal for volatile a D f v A L R W
apply (frule_tac A="𝒮" and B="𝒮'" and C="R" and x="W" in augment_mono_aux)
apply (frule_tac A="𝒮 ⊕⇘W⇙ R" and B="𝒮' ⊕⇘W⇙ R" and C="L" in restrict_mono_aux)
apply blast
done
apply clarsimp
apply clarsimp
apply clarsimp
subgoal for A L R W
apply (frule_tac A="𝒮" and B="𝒮'" and C="R" and x="W" in augment_mono_aux)
apply (frule_tac A="𝒮 ⊕⇘W⇙ R" and B="𝒮' ⊕⇘W⇙ R" and C="L" in restrict_mono_aux)
apply blast
done
done
done
lemma sharing_consistent_mono_owns:
"⋀𝒪 𝒪' 𝒮.
𝒪 ⊆ 𝒪' ⟹ sharing_consistent 𝒮 𝒪 sb ⟹ sharing_consistent 𝒮 𝒪' sb"
apply (induct sb)
apply simp
subgoal for a sb 𝒪 𝒪' 𝒮
apply (case_tac a)
apply clarsimp
subgoal for volatile a D f v A L R W
apply (frule_tac A="𝒪" and B="𝒪'" and C="A" in union_mono_aux)
apply (frule_tac A="𝒪 ∪ A" and B="𝒪' ∪ A" and C="R" in set_minus_mono_aux)
apply fastforce
done
apply clarsimp
apply clarsimp
apply clarsimp
subgoal for A L R W
apply (frule_tac A="𝒪" and B="𝒪'" and C="A" in union_mono_aux)
apply (frule_tac A="𝒪 ∪ A" and B="𝒪' ∪ A" and C="R" in set_minus_mono_aux)
apply fastforce
done
done
done
primrec all_shared :: "'a memref list ⇒ addr set"
where
"all_shared [] = {}"
| "all_shared (i#is) =
(case i of
Write⇩s⇩b volatile _ _ _ A L R W ⇒ (if volatile then R ∪ all_shared is else all_shared is)
| Ghost⇩s⇩b A L R W ⇒ R ∪ all_shared is
| _ ⇒ all_shared is)"
lemma sharing_consistent_all_shared:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ all_shared sb ⊆ dom 𝒮 ∪ 𝒪"
apply (induct sb)
apply clarsimp
subgoal for a
apply (case_tac a)
apply (fastforce split: memref.splits if_split_asm)
apply clarsimp
apply clarsimp
apply fastforce
done
done
lemma sharing_consistent_share_all_shared:
"⋀𝒮. dom (share sb 𝒮) ⊆ dom 𝒮 ∪ all_shared sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop t A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"]
show ?thesis
by (auto simp add: Write⇩s⇩b True)
next
case False with Cons Write⇩s⇩b show ?thesis by auto
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"]
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
primrec all_unshared :: "'a memref list ⇒ addr set"
where
"all_unshared [] = {}"
| "all_unshared (i#is) =
(case i of
Write⇩s⇩b volatile _ _ _ A L R W ⇒ (if volatile then L ∪ all_unshared is else all_unshared is)
| Ghost⇩s⇩b A L R W ⇒ L ∪ all_unshared is
| _ ⇒ all_unshared is)"
lemma all_unshared_append: "all_unshared (xs @ ys) = all_unshared xs ∪ all_unshared ys"
apply (induct xs)
apply simp
subgoal for a
apply (case_tac a)
apply auto
done
done
lemma freshly_shared_owned:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ dom (share sb 𝒮) - dom 𝒮 ⊆ 𝒪"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems show ?thesis by auto
qed
qed
lemma unshared_all_unshared:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ dom 𝒮 - dom (share sb 𝒮) ⊆ all_unshared sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems show ?thesis by auto
qed
qed
lemma unshared_acquired_or_owned:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ all_unshared sb ⊆ all_acquired sb ∪ 𝒪"
apply (induct sb)
apply simp
subgoal for a
apply (case_tac a)
apply auto+
done
done
lemma all_shared_acquired_or_owned:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ all_shared sb ⊆ all_acquired sb ∪ 𝒪"
apply (induct sb)
apply simp
subgoal for a
apply (case_tac a)
apply auto+
done
done
lemma sharing_consistent_preservation:
"⋀𝒮 𝒮' 𝒪.
⟦sharing_consistent 𝒮 𝒪 sb;
all_acquired sb ∩ dom 𝒮 - dom 𝒮' = {};
all_unshared sb ∩ dom 𝒮' - dom 𝒮 = {}⟧
⟹ sharing_consistent 𝒮' 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
have consis: "sharing_consistent 𝒮 𝒪 (x # sb)" by fact
have removed_cond: "all_acquired (x # sb) ∩ dom 𝒮 - dom 𝒮' = {}" by fact
have new_cond: "all_unshared (x # sb) ∩ dom 𝒮' - dom 𝒮 = {}" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False with Write⇩s⇩b Cons show ?thesis
by auto
next
case True
from consis obtain
A: "A ⊆ dom 𝒮 ∪ 𝒪" and
L: "L ⊆ A" and
A_R: "A ∩ R = {}" and
R: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from removed_cond obtain rem_cond: "(A ∪ all_acquired sb) ∩ dom 𝒮 ⊆ dom 𝒮'" by (clarsimp simp add: Write⇩s⇩b True)
hence rem_cond': "all_acquired sb ∩ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by auto
from new_cond obtain "(L ∪ all_unshared sb) ∩ dom 𝒮' ⊆ dom 𝒮" by (clarsimp simp add: Write⇩s⇩b True)
hence new_cond': "all_unshared sb ∩ dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by auto
from Cons.hyps [OF consis' rem_cond' new_cond']
have "sharing_consistent (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb".
moreover
from A rem_cond have "A ⊆ dom 𝒮' ∪ 𝒪"
by auto
moreover note L A_R R
ultimately show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case (Ghost⇩s⇩b A L R W)
from consis obtain
A: "A ⊆ dom 𝒮 ∪ 𝒪" and
L: "L ⊆ A" and
A_R: "A ∩ R = {}" and
R: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from removed_cond obtain rem_cond: "(A ∪ all_acquired sb) ∩ dom 𝒮 ⊆ dom 𝒮'" by (clarsimp simp add: Ghost⇩s⇩b)
hence rem_cond': "all_acquired sb ∩ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by auto
from new_cond obtain "(L ∪ all_unshared sb) ∩ dom 𝒮' ⊆ dom 𝒮" by (clarsimp simp add: Ghost⇩s⇩b)
hence new_cond': "all_unshared sb ∩ dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by auto
from Cons.hyps [OF consis' rem_cond' new_cond']
have "sharing_consistent (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb".
moreover
from A rem_cond have "A ⊆ dom 𝒮' ∪ 𝒪"
by auto
moreover note L A_R R
ultimately show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed (insert Cons, auto)
qed
lemma (in sharing_consis) sharing_consis_preservation:
assumes dist:
"∀i < length ts. let (_,_,_,sb,_,_,_) = ts!i in
all_acquired sb ∩ dom 𝒮 - dom 𝒮' = {} ∧ all_unshared sb ∩ dom 𝒮' - dom 𝒮 = {}"
shows "sharing_consis 𝒮' ts"
proof
fix i p "is" 𝒪 ℛ 𝒟 θ sb
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "sharing_consistent 𝒮' 𝒪 sb"
proof -
from sharing_consis [OF i_bound ts_i]
have consis: "sharing_consistent 𝒮 𝒪 sb".
from dist [rule_format, OF i_bound] ts_i
obtain
acq: "all_acquired sb ∩ dom 𝒮 - dom 𝒮' = {}" and
uns: "all_unshared sb ∩ dom 𝒮' - dom 𝒮 = {}"
by auto
from sharing_consistent_preservation [OF consis acq uns]
show ?thesis .
qed
qed
lemma (in sharing_consis) sharing_consis_shared_exchange:
assumes dist:
"∀i < length ts. let (_,_,_,sb,_,_,_) = ts!i in
∀a ∈ all_acquired sb. 𝒮' a = 𝒮 a"
shows "sharing_consis 𝒮' ts"
proof
fix i p "is" 𝒪 ℛ 𝒟 θ sb
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "sharing_consistent 𝒮' 𝒪 sb"
proof -
from sharing_consis [OF i_bound ts_i]
have consis: "sharing_consistent 𝒮 𝒪 sb".
from dist [rule_format, OF i_bound] ts_i
obtain
dist_sb: "∀a ∈ all_acquired sb. 𝒮' a = 𝒮 a"
by auto
from sharing_consistent_shared_exchange [OF dist_sb consis]
show ?thesis .
qed
qed
lemma all_acquired_takeWhile: "all_acquired (takeWhile P sb) ⊆ all_acquired sb"
proof -
from all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
show ?thesis
by auto
qed
lemma all_acquired_dropWhile: "all_acquired (dropWhile P sb) ⊆ all_acquired sb"
proof -
from all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
show ?thesis
by auto
qed
lemma acquired_share_owns_shared:
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "acquired pending_write sb 𝒪 ∪ dom (share sb 𝒮) ⊆ 𝒪 ∪ dom 𝒮"
proof -
from acquired_all_acquired have "acquired pending_write sb 𝒪 ⊆ 𝒪 ∪ all_acquired sb".
moreover
from sharing_consistent_all_acquired [OF consis] have "all_acquired sb ⊆ dom 𝒮 ∪ 𝒪".
moreover
from sharing_consistent_share_all_shared have "dom (share sb 𝒮) ⊆ dom 𝒮 ∪ all_shared sb".
moreover
from sharing_consistent_all_shared [OF consis] have "all_shared sb ⊆ dom 𝒮 ∪ 𝒪".
ultimately
show ?thesis
by blast
qed
lemma acquired_owns_shared:
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "acquired True sb 𝒪 ⊆ 𝒪 ∪ dom 𝒮"
using acquired_share_owns_shared [OF consis]
by blast
lemma share_owns_shared:
assumes consis: "sharing_consistent 𝒮 𝒪 sb"
shows "dom (share sb 𝒮) ⊆ 𝒪 ∪ dom 𝒮"
using acquired_share_owns_shared [OF consis]
by blast
lemma all_shared_append: "all_shared (xs@ys) = all_shared xs ∪ all_shared ys"
by (induct xs) (auto split: memref.splits)
lemma acquired_union_notin_first:
"⋀ pending_write A B. a ∈ acquired pending_write sb (A ∪ B) ⟹ a ∉ A ⟹ a ∈ acquired pending_write sb B"
proof (induct sb)
case Nil thus ?case by (auto split: if_split_asm)
next
case (Cons x sb)
then obtain a_notin_A: "a ∉ A" and
a_acq: "a ∈ acquired pending_write (x # sb) (A ∪ B)"
by blast
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L R W)
show ?thesis
proof (cases volatile)
case False
with Write⇩s⇩b Cons show ?thesis by simp
next
case True
note volatile = this
show ?thesis
proof (cases pending_write)
case True
from a_acq have a_acq': "a ∈ acquired True sb (A ∪ B ∪ A' - R)"
by (simp add: Write⇩s⇩b volatile True)
have "(A ∪ B ∪ A' - R) ⊆ (A ∪ (B ∪ A' - R))"
by auto
from acquired_mono_in [OF a_acq' this]
have "a ∈ acquired True sb (A ∪ (B ∪ A' - R))".
from Cons.hyps [OF this a_notin_A]
have "a ∈ acquired True sb (B ∪ A' - R)".
then
show ?thesis by (simp add: Write⇩s⇩b volatile True)
next
case False
from a_acq have a_acq': "a ∈ acquired True sb (A' - R)"
by (simp add: Write⇩s⇩b volatile False)
then
show ?thesis
by (simp add: Write⇩s⇩b volatile False)
qed
qed
next
case (Ghost⇩s⇩b A' L R W)
show ?thesis
proof (cases pending_write)
case True
from a_acq have a_acq': "a ∈ acquired True sb (A ∪ B ∪ A' - R)"
by (simp add: Ghost⇩s⇩b True)
have "(A ∪ B ∪ A' - R) ⊆ (A ∪ (B ∪ A' - R))"
by auto
from acquired_mono_in [OF a_acq' this]
have "a ∈ acquired True sb (A ∪ (B ∪ A' - R))".
from Cons.hyps [OF this a_notin_A]
have "a ∈ acquired True sb (B ∪ A' - R)".
then
show ?thesis by (simp add: Ghost⇩s⇩b True)
next
case False
from a_acq have a_acq': "a ∈ acquired False sb (A ∪ B)"
by (simp add: Ghost⇩s⇩b False)
from Cons.hyps [OF this a_notin_A]
show ?thesis
by (simp add: Ghost⇩s⇩b False)
qed
qed (insert Cons, auto)
qed
lemma split_all_acquired_in:
"a ∈ all_acquired xs ⟹
(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W# zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A)"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
have a_in: "a ∈ all_acquired (x # xs)" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
from a_in have "a ∈ all_acquired xs"
by (auto simp add: False Write⇩s⇩b)
from Cons.hyps [OF this]
have "(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W# zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W # zs ∧ a ∈ A)" (is "?write ∨ ?ghst").
then
show ?thesis
proof
assume ?write
then
obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
next
assume ?ghst
then obtain A'' L'' R'' W'' ys zs where
"xs=ys@Ghost⇩s⇩b A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Ghost⇩s⇩b A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
qed
next
case True
note volatile = this
show ?thesis
proof (cases "a ∈ A")
case False
with a_in have "a ∈ all_acquired xs"
by (auto simp add: volatile Write⇩s⇩b)
from Cons.hyps [OF this]
have "(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A)" (is "?write ∨ ?ghst").
then
show ?thesis
proof
assume ?write
then
obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W'' #zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
next
assume ?ghst
then obtain A'' L'' R'' W'' ys zs where
"xs=ys @Ghost⇩s⇩b A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Ghost⇩s⇩b A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
qed
next
case True
then have "x#xs=[]@(Write⇩s⇩b True a' sop v A L R W#xs)"
by (simp add: Write⇩s⇩b volatile True)
thus ?thesis
using True
by blast
qed
qed
next
case Read⇩s⇩b
from a_in have "a ∈ all_acquired xs"
by (auto simp add: Read⇩s⇩b)
from Cons.hyps [OF this]
have "(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W# zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A)" (is "?write ∨ ?ghst").
then
show ?thesis
proof
assume ?write
then
obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
next
assume ?ghst
then obtain A'' L'' R'' W'' ys zs where
"xs=ys@Ghost⇩s⇩b A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Ghost⇩s⇩b A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
qed
next
case Prog⇩s⇩b
from a_in have "a ∈ all_acquired xs"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF this]
have "(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W# zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A)" (is "?write ∨ ?ghst").
then
show ?thesis
proof
assume ?write
then
obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
next
assume ?ghst
then obtain A'' L'' R'' W'' ys zs where
"xs=ys@Ghost⇩s⇩b A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Ghost⇩s⇩b A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
qed
next
case (Ghost⇩s⇩b A L R W)
show ?thesis
proof (cases "a ∈ A")
case False
with a_in have "a ∈ all_acquired xs"
by (auto simp add: Ghost⇩s⇩b)
from Cons.hyps [OF this]
have "(∃sop a' v ys zs A L R W. xs = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧ a ∈ A) ∨
(∃A L R W ys zs. xs = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A)" (is "?write ∨ ?ghst").
then
show ?thesis
proof
assume ?write
then
obtain sop'' a'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b True a'' sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
next
assume ?ghst
then obtain A'' L'' R'' W'' ys zs where
"xs=ys@Ghost⇩s⇩b A'' L'' R'' W''#zs" and a_in: "a ∈ A''"
by auto
hence "x#xs = (x#ys)@Ghost⇩s⇩b A'' L'' R'' W''#zs"
by auto
thus ?thesis
using a_in
by blast
qed
next
case True
then have "x#xs=[]@(Ghost⇩s⇩b A L R W#xs)"
by (simp add: Ghost⇩s⇩b True)
thus ?thesis
using True
by blast
qed
qed
qed
lemma split_Write⇩s⇩b_in_outstanding_refs:
"a ∈ outstanding_refs is_Write⇩s⇩b xs ⟹ (∃sop volatile v ys zs A L R W. xs = ys@(Write⇩s⇩b volatile a sop v A L R W#zs))"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
have a_in: "a ∈ outstanding_refs is_Write⇩s⇩b (x # xs)" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases "a'=a")
case False
with a_in have "a ∈ outstanding_refs is_Write⇩s⇩b xs"
by (auto simp add: Write⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case True
then have "x#xs=[]@(Write⇩s⇩b volatile a sop v A L R W#xs)"
by (simp add: Write⇩s⇩b True)
thus ?thesis
by blast
qed
next
case Read⇩s⇩b
from a_in have "a ∈ outstanding_refs is_Write⇩s⇩b xs"
by (auto simp add: Read⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W'' #zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case Prog⇩s⇩b
from a_in have "a ∈ outstanding_refs is_Write⇩s⇩b xs"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
next
case Ghost⇩s⇩b
from a_in have "a ∈ outstanding_refs is_Write⇩s⇩b xs"
by (auto simp add: Ghost⇩s⇩b)
from Cons.hyps [OF this] obtain sop'' volatile'' v'' A'' L'' R'' W'' ys zs
where "xs=ys@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
hence "x#xs = (x#ys)@Write⇩s⇩b volatile'' a sop'' v'' A'' L'' R'' W''#zs"
by auto
thus ?thesis
by blast
qed
qed
lemma outstanding_refs_is_Write⇩s⇩b_union:
"outstanding_refs is_Write⇩s⇩b xs =
(outstanding_refs is_volatile_Write⇩s⇩b xs ∪ outstanding_refs is_non_volatile_Write⇩s⇩b xs)"
apply (induct xs)
apply simp
subgoal for a
apply (case_tac a)
apply auto
done
done
lemma rtranclp_r_rtranclp: "⟦r⇧*⇧* x y; r y z⟧ ⟹ r⇧*⇧* x z"
by auto
lemma r_rtranclp_rtranclp: "⟦r x y; r⇧*⇧* y z⟧ ⟹ r⇧*⇧* x z"
by auto
lemma unshared_is_non_volatile_Write⇩s⇩b: "⋀𝒮.
⟦non_volatile_writes_unshared 𝒮 sb; a ∈ dom 𝒮; a ∉ all_unshared sb⟧ ⟹
a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" ] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"] Cons.prems show ?thesis by auto
qed
qed
lemma outstanding_non_volatile_Read⇩s⇩b_acquired_or_read_only_reads:
"⋀𝒪 𝒮 pending_write.
⟦non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb⟧
⟹ a ∈ acquired_reads True sb 𝒪 ∨ a ∈ read_only_reads 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
with Write⇩s⇩b Cons.hyps [of True "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒪 ∪ A - R)"] Cons.prems
show ?thesis by auto
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case (Read⇩s⇩b volatile a' t v)
show ?thesis
proof (cases volatile)
case False with Read⇩s⇩b Cons show ?thesis by auto
next
case True
with Read⇩s⇩b Cons show ?thesis by auto
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W) with Cons.hyps [of pending_write "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "𝒪 ∪ A - R"] Cons.prems
show ?thesis
by auto
qed
qed
lemma acquired_reads_union: "⋀pending_writes A B.
⟦a ∈ acquired_reads pending_writes sb (A ∪ B); a ∉ A⟧ ⟹ a ∈ acquired_reads pending_writes sb B"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L' R' W')
show ?thesis
proof (cases volatile)
case True
note volatile=this
show ?thesis
proof (cases pending_writes)
case True
from Cons.prems obtain
a_in: "a ∈ acquired_reads True sb (A ∪ B ∪ A' - R')" and
a_notin: "a ∉ A"
by (simp add: Write⇩s⇩b volatile True)
have "(A ∪ B ∪ A' - R') ⊆ (A ∪ (B ∪ A' - R'))"
by auto
from acquired_reads_mono [OF this ] a_in
have "a ∈ acquired_reads True sb (A ∪ (B ∪ A' - R'))"
by auto
from Cons.hyps [OF this a_notin]
have "a ∈ acquired_reads True sb (B ∪ A' - R')".
then show ?thesis
by (simp add: Write⇩s⇩b volatile True)
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b volatile False)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by (auto split: if_split_asm)
next
case Prog⇩s⇩b with Cons show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A' L' R' W')
show ?thesis
proof -
from Cons.prems obtain
a_in: "a ∈ acquired_reads pending_writes sb (A ∪ B ∪ A' - R')" and
a_notin: "a ∉ A"
by (simp add: Ghost⇩s⇩b )
have "(A ∪ B ∪ A' - R') ⊆ (A ∪ (B ∪ A' - R'))"
by auto
from acquired_reads_mono [OF this ] a_in
have "a ∈ acquired_reads pending_writes sb (A ∪ (B ∪ A' - R'))"
by auto
from Cons.hyps [OF this a_notin]
have "a ∈ acquired_reads pending_writes sb (B ∪ A' - R')".
then show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma non_volatile_writes_unshared_no_outstanding_non_volatile_Write⇩s⇩b: "⋀𝒮 𝒮'.
⟦non_volatile_writes_unshared 𝒮 sb;
∀a ∈ dom 𝒮' - dom 𝒮. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb ⟧
⟹ non_volatile_writes_unshared 𝒮' sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
unshared_sb: "non_volatile_writes_unshared (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
no_refs_sb: "∀a∈dom 𝒮' - dom 𝒮. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (simp add: Write⇩s⇩b True)
from no_refs_sb have "∀a∈dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L).
a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by auto
from Cons.hyps [OF unshared_sb this]
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by (auto)
next
case Prog⇩s⇩b with Cons show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
unshared_sb: "non_volatile_writes_unshared (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
no_refs_sb: "∀a∈dom 𝒮' - dom 𝒮. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by (simp add: Ghost⇩s⇩b)
from no_refs_sb have "∀a∈dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L).
a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
by auto
from Cons.hyps [OF unshared_sb this]
show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
theorem sharing_consis_share_all_until_volatile_write:
"⋀𝒮 ts'. ⟦ownership_distinct ts; sharing_consis 𝒮 ts; length ts' = length ts;
∀i < length ts.
(let (_,_,_,sb,_,𝒪,_) = ts!i;
(_,_,_,sb',_,𝒪',_) = ts'!i
in 𝒪' = acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
sb' = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)⟧ ⟹
sharing_consis (share_all_until_volatile_write ts 𝒮) ts' ∧
dom (share_all_until_volatile_write ts 𝒮) - dom 𝒮 ⊆
⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts) ∧
dom 𝒮 - dom (share_all_until_volatile_write ts 𝒮) ⊆
⋃ ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb ∪ 𝒪) ` set ts)"
proof (induct ts)
case Nil thus ?case by auto
next
case (Cons t ts)
have leq: "length ts' = length (t#ts)" by fact
have sim: "∀i < length (t#ts).
(let (_,_,_,sb,_,𝒪,_) = (t#ts)!i;
(_,_,_,sb',_,𝒪',_) = ts'!i
in 𝒪' = acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
sb' = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by fact
obtain p "is" 𝒪 ℛ 𝒟 θ sb
where t: "t = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
from leq obtain t' ts'' where ts': "ts'=t'#ts''" and leq': "length ts'' = length ts"
by (cases ts') force+
obtain p' "is'" 𝒪' ℛ' 𝒟' θ' sb'
where t': "t' = (p',is',θ',sb',𝒟',𝒪',ℛ')"
by (cases t')
from sim [rule_format, of 0] t t' ts'
obtain 𝒪': "𝒪' = acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪" and
sb': "sb' = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
by auto
from sim ts'
have sim': "∀i < length ts.
(let (_,_,_,sb,_,𝒪,ℛ) = ts!i;
(_,_,_,sb',_,𝒪',ℛ) = ts''!i
in 𝒪' = acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
sb' = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by auto
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "(t#ts)".
from sharing_consis [of 0] t
have consis_sb: "sharing_consistent 𝒮 𝒪 sb"
by fastforce
from sharing_consistent_takeWhile [OF this]
have consis': "sharing_consistent 𝒮 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by simp
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
from freshly_shared_owned [OF consis']
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪".
from unshared_all_unshared [OF consis'] unshared_acquired_or_owned [OF consis']
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ 𝒪"
by simp
have dist: "ownership_distinct (t#ts)" by fact
from ownership_distinct_tl [OF this]
have dist': "ownership_distinct ts" .
from sharing_consis_tl [OF consis]
interpret consis': sharing_consis 𝒮 "ts".
from dist interpret ownership_distinct "(t#ts)".
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have consis_ts: "sharing_consis ?𝒮' ts".
from Cons.hyps [OF dist' this leq' sim']
obtain consis_ts'':
"sharing_consis (share_all_until_volatile_write ts ?𝒮') ts''" and
fresh: "dom (share_all_until_volatile_write ts ?𝒮') - dom ?𝒮' ⊆
⋃ ((λ(_,_,_,_,_,𝒪,ℛ). 𝒪) ` set ts)" and
unshared: "dom ?𝒮' - dom (share_all_until_volatile_write ts ?𝒮') ⊆
⋃ ((λ(_,_,_,sb,_,𝒪,ℛ). all_acquired sb ∪ 𝒪)` set ts)"
by auto
from sharing_consistent_append [of _ _ "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"] consis_sb
have consis_t': "sharing_consistent ?𝒮' 𝒪' sb'"
by (simp add: 𝒪' sb')
have fresh_dist: "all_acquired sb' ∩ dom ?𝒮' - dom (share_all_until_volatile_write ts ?𝒮') = {}"
proof -
have "all_acquired sb' ∩ ⋃ ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb ∪ 𝒪)` set ts) = {}"
proof -
{
fix x
assume x_sb': "x ∈ all_acquired sb'"
assume x_ts: "x ∈ ⋃ ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb ∪ 𝒪)` set ts)"
have False
proof -
from x_ts
obtain i p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i where
i_bound: "i < length ts" and
ts_i: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)" and
x_in: "x ∈ all_acquired sb⇩i ∪ 𝒪⇩i"
by (force simp add: in_set_conv_nth)
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
with x_sb' x_in all_acquired_dropWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" "sb"] show False
by (auto simp add: sb')
qed
}
thus ?thesis by blast
qed
with unshared show ?thesis
by blast
qed
have unshared_dist: "all_unshared sb' ∩ dom (share_all_until_volatile_write ts ?𝒮') - dom ?𝒮' = {}"
proof -
from unshared_acquired_or_owned [OF consis_t']
have "all_unshared sb' ⊆ all_acquired sb' ∪ 𝒪'".
also
from all_acquired_dropWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" "sb"]
acquired_all_acquired [of True "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb" 𝒪]
all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" "sb"]
have "all_acquired sb' ∪ 𝒪' ⊆ all_acquired sb ∪ 𝒪"
by (auto simp add: sb' 𝒪')
finally
have "all_unshared sb' ⊆ (all_acquired sb ∪ 𝒪)".
moreover
have "(all_acquired sb ∪ 𝒪) ∩ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts) = {}"
proof -
{
fix x
assume x_sb': "x ∈ all_acquired sb ∪ 𝒪"
assume x_ts: "x ∈ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪)` set ts)"
have False
proof -
from x_ts
obtain i p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i where
i_bound: "i < length ts" and
ts_i: "ts!i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)" and
x_in: "x ∈ 𝒪⇩i"
by (force simp add: in_set_conv_nth)
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
with x_sb' x_in show False
by (auto simp add: sb')
qed
}
thus ?thesis by blast
qed
ultimately show ?thesis
using fresh by fastforce
qed
from sharing_consistent_preservation [OF consis_t' fresh_dist unshared_dist]
have consis_ts: "sharing_consistent (share_all_until_volatile_write ts ?𝒮') 𝒪' sb'".
note sharing_consis_Cons [OF consis_ts'' consis_ts, of p' is' θ' 𝒟' ]
moreover
from fresh fresh_owned
have "dom (share_all_until_volatile_write ts ?𝒮') - dom 𝒮 ⊆
𝒪 ∪ ⋃ ((λ(_,_,_,_,_,𝒪,_). 𝒪) ` set ts)"
by auto
moreover
from unshared unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb]
have "dom 𝒮 - dom (share_all_until_volatile_write ts ?𝒮') ⊆
all_acquired sb ∪ 𝒪 ∪ ⋃ ((λ(_,_,_,sb,_,𝒪,_). all_acquired sb ∪ 𝒪) ` set ts)"
by auto
ultimately
show ?case
by (auto simp add: t ts' t')
qed
corollary sharing_consistent_share_all_until_volatile_write:
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
shows "sharing_consistent (share_all_until_volatile_write ts 𝒮)
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
proof -
define ts' where "ts' == map (λ(p,is,θ,sb,𝒟,𝒪,ℛ).
(p,is,θ,
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb,𝒟,acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪,ℛ)) ts"
have leq: "length ts' = length ts"
by (simp add: ts'_def)
have flush: "∀i < length ts.
(let (_,_,_,sb,_,𝒪,_) = ts!i;
(_,_,_,sb',_,𝒪',_) = ts'!i
in 𝒪' = acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
sb' = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: ts'_def Let_def)
from sharing_consis_share_all_until_volatile_write [OF dist consis leq flush]
interpret sharing_consis "(share_all_until_volatile_write ts 𝒮)" "ts'" by simp
from i_bound leq ts_i sharing_consis [of i]
show ?thesis
by (force simp add: ts'_def)
qed
lemma restrict_map_UNIV [simp]: "S |` UNIV = S"
by (auto simp add: restrict_map_def)
lemma share_all_until_volatile_write_Read_commute:
shows "⋀S i. ⟦i < length ls; ls!i=(p,Read volatile a t#is,θ,sb,𝒟,𝒪)
⟧
⟹
share_all_until_volatile_write
(ls[i := (p,is, θ(t↦v), sb @ [Read⇩s⇩b volatile a t v],𝒟', 𝒪)]) S =
share_all_until_volatile_write ls S"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,Read volatile a t#is,θ,sb,𝒟,𝒪)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,Read volatile a t#is,θ,sb,𝒟,𝒪)"
by simp
thus ?thesis
by (simp add: 0 share_append_Read⇩s⇩b del: fun_upd_apply )
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l)"
by (cases l)
from i_bound ith
have "share_all_until_volatile_write
(ls[n := (p,is, θ(t↦v), sb @ [Read⇩s⇩b volatile a t v],𝒟', 𝒪)])
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S) =
share_all_until_volatile_write ls (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then
show ?thesis
by (simp add: Suc l del: fun_upd_apply)
qed
qed
lemma share_all_until_volatile_write_Write_commute:
shows "⋀S i. ⟦i < length ls; ls!i=(p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)
⟧
⟹
share_all_until_volatile_write
(ls[i := (p,is,θ, sb @ [Write⇩s⇩b volatile a t (f θ) A L R W], 𝒟', 𝒪)]) S =
share_all_until_volatile_write ls S"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,Write volatile a (D,f) A L R W#is,θ,sb,𝒟,𝒪)"
by simp
thus ?thesis
by (simp add: 0 share_append_Write⇩s⇩b del: fun_upd_apply )
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l)"
by (cases l)
from i_bound ith
have "share_all_until_volatile_write
(ls[n := (p,is, θ, sb @ [Write⇩s⇩b volatile a t (f θ) A L R W],𝒟', 𝒪)])
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S) =
share_all_until_volatile_write ls (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then
show ?thesis
by (simp add: Suc l del: fun_upd_apply)
qed
qed
lemma share_all_until_volatile_write_RMW_commute:
shows "⋀S i. ⟦i < length ls; ls!i=(p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)
⟧
⟹
share_all_until_volatile_write (ls[i := (p',is, θ', [],𝒟', 𝒪')]) S =
share_all_until_volatile_write ls S"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,RMW a t (D,f) cond ret A L R W#is,θ,[],𝒟,𝒪)"
by simp
thus ?thesis
by (simp add: 0 share_append_Write⇩s⇩b del: fun_upd_apply )
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l)"
by (cases l)
from i_bound ith
have "share_all_until_volatile_write
(ls[n := (p',is,θ', [], 𝒟', 𝒪')])
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S) =
share_all_until_volatile_write ls (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then
show ?thesis
by (simp add: Suc l del: fun_upd_apply)
qed
qed
lemma share_all_until_volatile_write_Fence_commute:
shows "⋀S i. ⟦i < length ls; ls!i=(p,Fence#is,θ,[],𝒟,𝒪,ℛ)
⟧
⟹
share_all_until_volatile_write (ls[i := (p,is,θ, [], 𝒟', 𝒪,ℛ')]) S =
share_all_until_volatile_write ls S"
proof (induct ls)
case Nil thus ?case
by simp
next
case (Cons l ls)
note i_bound = ‹i < length (l#ls)›
note ith = ‹(l#ls)!i = (p,Fence#is,θ,[],𝒟,𝒪,ℛ)›
show ?case
proof (cases i)
case 0
from ith 0 have l: "l = (p,Fence#is,θ,[],𝒟,𝒪,ℛ)"
by simp
thus ?thesis
by (simp add: 0 share_append_Write⇩s⇩b del: fun_upd_apply )
next
case (Suc n)
obtain p⇩l "is⇩l" 𝒪⇩l ℛ⇩l 𝒟⇩l θ⇩l sb⇩l where l: "l = (p⇩l,is⇩l,θ⇩l,sb⇩l,𝒟⇩l,𝒪⇩l,ℛ⇩l)"
by (cases l)
from i_bound ith
have "share_all_until_volatile_write
(ls[n := (p,is, θ, [],𝒟', 𝒪,ℛ')])
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S) =
share_all_until_volatile_write ls (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩l) S)"
apply -
apply (rule Cons.hyps)
apply (auto simp add: Suc l)
done
then
show ?thesis
by (simp add: Suc l del: fun_upd_apply)
qed
qed
lemma unshared_share_in: "⋀S. a ∈ dom S ⟹ a ∉ all_unshared sb ⟹ a ∈ dom (share sb S)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
show ?thesis
proof -
from Cons.prems obtain a_S: "a ∈ dom S" and a_L: "a ∉ L" and a_sb: "a ∉ all_unshared sb"
by (clarsimp simp add: Write⇩s⇩b True)
from a_S a_L have "a ∈ dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from Cons.hyps [OF this a_sb]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Ghost⇩s⇩b
with Cons show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma dom_eq_dom_share_eq: "⋀S S'. dom S = dom S' ⟹ dom (share sb S) = dom (share sb S')"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems
have "dom (S ⊕⇘W⇙ R ⊖⇘A'⇙ L) = dom (S' ⊕⇘W⇙ R ⊖⇘A'⇙ L)"
by auto
from Cons.hyps [OF this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons.hyps [of S S'] Cons.prems Write⇩s⇩b show ?thesis by auto
qed
next
case Read⇩s⇩b with Cons.hyps [of S S'] Cons.prems show ?thesis by auto
next
case Prog⇩s⇩b with Cons.hyps [of S S'] Cons.prems show ?thesis by auto
next
case (Ghost⇩s⇩b A' L R W)
from Cons.prems
have "dom (S ⊕⇘W⇙ R ⊖⇘A'⇙ L) = dom (S' ⊕⇘W⇙ R ⊖⇘A'⇙ L)"
by auto
from Cons.hyps [OF this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_union:
"⋀A B. ⟦a ∈ dom (share sb (A ⊕⇘z⇙ B)); a ∉ dom A⟧ ⟹ a ∈ dom (share sb (Map.empty ⊕⇘z⇙ B))"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems
obtain a_in: "a ∈ dom (share sb ((A ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L))" and a_A: "a ∉ dom A"
by (clarsimp simp add: Write⇩s⇩b True)
have "dom ((A ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L) ⊆ dom (A ⊕⇘z⇙ (B ∪ R - L))"
by auto
from share_mono [OF this] a_in
have "a ∈ dom (share sb (A ⊕⇘z⇙ (B ∪ R - L)))"
by blast
from Cons.hyps [OF this] a_A
have "a ∈ dom (share sb (Map.empty ⊕⇘z⇙ (B ∪ R - L)))"
by blast
moreover
have "dom (Map.empty ⊕⇘z⇙ B ∪ R - L) = dom ((Map.empty ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L)"
by auto
note dom_eq_dom_share_eq [OF this, of sb]
ultimately
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A' L R W)
from Cons.prems
obtain a_in: "a ∈ dom (share sb ((A ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L))" and a_A: "a ∉ dom A"
by (clarsimp simp add: Ghost⇩s⇩b)
have "dom ((A ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L) ⊆ dom (A ⊕⇘z⇙ (B ∪ R - L))"
by auto
from share_mono [OF this] a_in
have "a ∈ dom (share sb (A ⊕⇘z⇙ (B ∪ R - L)))"
by blast
from Cons.hyps [OF this] a_A
have "a ∈ dom (share sb (Map.empty ⊕⇘z⇙ (B ∪ R - L)))"
by blast
moreover
have "dom (Map.empty ⊕⇘z⇙ B ∪ R - L) = dom ((Map.empty ⊕⇘z⇙ B) ⊕⇘W⇙ R ⊖⇘A'⇙ L)"
by auto
note dom_eq_dom_share_eq [OF this, of sb]
ultimately
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_unshared_in:
"⋀S. a ∈ dom (share sb S) ⟹ a ∈ dom (share sb Map.empty) ∨ (a ∈ dom S ∧ a ∉ all_unshared sb)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
have a_in: "a ∈ dom (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ dom S")
case True
from Cons.hyps [OF a_in]
have "a ∈ dom (share sb Map.empty) ∨ a ∈ dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_unshared sb".
then show ?thesis
proof
assume "a ∈ dom (share sb Map.empty)"
from share_mono_in [OF this]
have "a ∈ dom (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))" by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile True)
next
assume "a ∈ dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_unshared sb"
then obtain "a ∉ L" "a ∉ all_unshared sb"
by auto
then show ?thesis by (clarsimp simp add: Write⇩s⇩b volatile True)
qed
next
case False
have "dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ dom (S ⊕⇘W⇙ (R - L))"
by auto
from share_mono [OF this] a_in
have "a ∈ dom (share sb (S ⊕⇘W⇙ (R - L)))" by blast
from share_union [OF this False]
have "a ∈ dom (share sb (Map.empty ⊕⇘W⇙ (R - L)))".
moreover
have "dom (Map.empty ⊕⇘W⇙ (R - L)) = dom (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
note dom_eq_dom_share_eq [OF this, of sb]
ultimately
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
have a_in: "a ∈ dom (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ dom S")
case True
from Cons.hyps [OF a_in]
have "a ∈ dom (share sb Map.empty) ∨ a ∈ dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_unshared sb".
then show ?thesis
proof
assume "a ∈ dom (share sb Map.empty)"
from share_mono_in [OF this]
have "a ∈ dom (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))" by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b True)
next
assume "a ∈ dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_unshared sb"
then obtain "a ∉ L" "a ∉ all_unshared sb"
by auto
then show ?thesis by (clarsimp simp add: Ghost⇩s⇩b True)
qed
next
case False
have "dom (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ dom (S ⊕⇘W⇙ (R - L))"
by auto
from share_mono [OF this] a_in
have "a ∈ dom (share sb (S ⊕⇘W⇙ (R - L)))" by blast
from share_union [OF this False]
have "a ∈ dom (share sb (Map.empty ⊕⇘W⇙ (R - L)))".
moreover
have "dom (Map.empty ⊕⇘W⇙ (R - L)) = dom (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
note dom_eq_dom_share_eq [OF this, of sb]
ultimately
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b False)
qed
qed
qed
lemma dom_augment_rels_shared_eq: "dom (augment_rels S R ℛ) = dom (augment_rels S' R ℛ)"
by (auto simp add: augment_rels_def domIff split: option.splits if_split_asm)
lemma dom_eq_SomeD1: "dom m = dom n ⟹ m x = Some y ⟹ n x ≠ None"
by (auto simp add: dom_def)
lemma dom_eq_SomeD2: "dom m = dom n ⟹ n x = Some y ⟹ m x ≠ None"
by (auto simp add: dom_def)
lemma dom_augment_rels_rels_eq: "dom ℛ' = dom ℛ ⟹ dom (augment_rels S R ℛ') = dom (augment_rels S R ℛ)"
by (auto simp add: augment_rels_def domIff split: option.splits if_split_asm dest: dom_eq_SomeD1 dom_eq_SomeD2)
lemma dom_release_rels_eq: "⋀𝒮 ℛ ℛ'. dom ℛ' = dom ℛ ⟹
dom (release sb 𝒮 ℛ') = dom (release sb 𝒮 ℛ)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
hence dr: "dom ℛ' = dom ℛ"
by simp
show ?case
proof (cases x)
case Write⇩s⇩b with Cons.hyps [OF dr] show ?thesis by (clarsimp)
next
case Read⇩s⇩b with Cons.hyps [OF dr] show ?thesis by (clarsimp)
next
case Prog⇩s⇩b with Cons.hyps [OF dr] show ?thesis by (clarsimp)
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [OF dom_augment_rels_rels_eq [OF dr]]
show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
lemma dom_release_shared_eq: "⋀𝒮 𝒮' ℛ. dom (release sb 𝒮' ℛ) = dom (release sb 𝒮 ℛ)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case Write⇩s⇩b with Cons.hyps show ?thesis by (clarsimp)
next
case Read⇩s⇩b with Cons.hyps show ?thesis by (clarsimp)
next
case Prog⇩s⇩b with Cons.hyps show ?thesis by (clarsimp)
next
case (Ghost⇩s⇩b A L R W)
have dr: "dom (augment_rels 𝒮' R ℛ) = dom (augment_rels 𝒮 R ℛ)"
by(rule dom_augment_rels_shared_eq)
have "dom (release sb (𝒮' ∪ R - L) (augment_rels 𝒮' R ℛ)) =
dom (release sb (𝒮 ∪ R - L) (augment_rels 𝒮' R ℛ))"
by (rule Cons.hyps)
also have "... = dom (release sb (𝒮 ∪ R - L) (augment_rels 𝒮 R ℛ))"
by (rule dom_release_rels_eq [OF dr])
finally show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_other_untouched:
"⋀𝒪 𝒮. sharing_consistent 𝒮 𝒪 sb ⟹ a ∉ 𝒪 ∪ all_acquired sb⟹ share sb 𝒮 a = 𝒮 a"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_owns: "a ∉ 𝒪" and a_A: "a ∉ A" and a_sb: "a ∉ all_acquired sb"
by ( simp add: Write⇩s⇩b True )
from a_owns a_A a_sb
have "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from Cons.hyps [OF consis' this]
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a".
moreover have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
using L_A A_R R_owns a_owns a_A
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
ultimately show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons
show ?thesis
by (auto)
next
case Prog⇩s⇩b with Cons
show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_owns: "a ∉ 𝒪" and a_A: "a ∉ A" and a_sb: "a ∉ all_acquired sb"
by ( simp add: Ghost⇩s⇩b )
from a_owns a_A a_sb
have "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from Cons.hyps [OF consis' this]
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a".
moreover have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
using L_A A_R R_owns a_owns a_A
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
ultimately show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
lemma shared_owned: "⋀𝒪 𝒮. sharing_consistent 𝒮 𝒪 sb ⟹ a ∉ dom 𝒮 ⟹ a ∈ dom (share sb 𝒮) ⟹
a ∈ 𝒪 ∪ all_acquired sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_notin: "a ∉ dom 𝒮" and a_in: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by ( simp add: Write⇩s⇩b True )
show ?thesis
proof (cases "a ∈ 𝒪")
case True thus ?thesis by auto
next
case False
with a_notin R_owns A_shared_owns L_A A_R have "a ∉ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto)
from Cons.hyps [OF consis' this a_in]
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons
show ?thesis
by (auto)
next
case Prog⇩s⇩b with Cons
show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_notin: "a ∉ dom 𝒮" and a_in: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ 𝒪")
case True thus ?thesis by auto
next
case False
with a_notin R_owns A_shared_owns L_A A_R have "a ∉ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto)
from Cons.hyps [OF consis' this a_in]
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma share_all_shared_in: "a ∈ dom (share sb 𝒮) ⟹ a ∈ dom 𝒮 ∨ a ∈ all_shared sb"
using sharing_consistent_share_all_shared [of sb 𝒮]
by auto
lemma share_all_until_volatile_write_unowned:
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes other: "∀i p is θ sb 𝒟 𝒪 ℛ. i < length ts ⟶ ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
a ∉ 𝒪 ∪ all_acquired sb"
shows "share_all_until_volatile_write ts 𝒮 a = 𝒮 a"
using dist consis other
proof (induct ts arbitrary: 𝒮)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
from Cons.prems t obtain
other': "∀i p is θ sb 𝒟 𝒪 ℛ. i < length ts ⟶ ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
a ∉ 𝒪 ∪ all_acquired sb" and
a_notin: "a ∉ 𝒪⇩t ∪ all_acquired sb⇩t"
apply -
apply (rule that)
apply clarsimp
subgoal for i p "is" θ sb 𝒟 𝒪 ℛ
apply (drule_tac x="Suc i" in spec)
apply clarsimp
done
apply (drule_tac x="0" in spec)
apply clarsimp
done
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts".
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts".
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts".
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)"
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t".
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)".
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF this]
have "sharing_consis ?𝒮' ts".
from Cons.hyps [OF dist' this other']
have "share_all_until_volatile_write ts ?𝒮' a =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮 a" .
moreover
from share_other_untouched [OF consis_sb] a_notin
all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"]
have "share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮 a = 𝒮 a"
by auto
ultimately
show ?case
by (simp add: t)
qed
lemma share_shared_eq: "⋀𝒮' 𝒮. 𝒮' a = 𝒮 a ⟹ share sb 𝒮' a = share sb 𝒮 a"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
have eq: "𝒮' a = 𝒮 a" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
using eq by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [of "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)", OF this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False
with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons.hyps [of 𝒮' 𝒮] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
using eq by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [of "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)", OF this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_all_until_volatile_write_thread_local:
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_owned: "a ∈ 𝒪 ∪ all_acquired sb"
shows "share_all_until_volatile_write ts 𝒮 a = share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮 a"
using dist consis i_bound ts_i
proof (induct ts arbitrary: 𝒮 i)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts".
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts".
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts".
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)"
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t".
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)".
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF this]
have consis_shared': "sharing_consis ?𝒮' ts".
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases "i")
case 0
with Cons.prems
have t': "t = (p, is, θ, sb, 𝒟, 𝒪, ℛ)"
by simp
{
fix j p⇩j "is⇩j" θ⇩j sb⇩j 𝒟⇩j 𝒪⇩j ℛ⇩j
assume j_bound: "j < length ts"
assume ts_j: "ts ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
have "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof -
from ownership_distinct [of "0" "Suc j", simplified, OF j_bound t ts_j] t a_owned t' 0
show ?thesis
by auto
qed
}
with share_all_until_volatile_write_unowned [OF dist' consis_shared', of a]
have "share_all_until_volatile_write ts ?𝒮' a = ?𝒮' a"
by fastforce
then show ?thesis
using t t' 0
by (auto simp add: Cons t aargh)
next
case (Suc n)
with Cons.prems obtain n_bound: "n < length ts" and ts_n: "ts!n = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by auto
from Cons.hyps [OF dist' consis_shared' n_bound ts_n]
have "share_all_until_volatile_write ts ?𝒮' a =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ?𝒮' a" .
moreover
from ownership_distinct [of "0" "Suc n"] t a_owned ts_n n_bound
have "a ∉ 𝒪⇩t ∪ all_acquired sb⇩t"
by fastforce
with share_other_untouched [OF consis_sb, of a]
all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"]
have "?𝒮' a = 𝒮 a"
by auto
from share_shared_eq [of ?𝒮' a 𝒮,OF this ]
have "share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ?𝒮' a =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮 a" .
ultimately show ?thesis
using t Suc
by (auto simp add: aargh)
qed
qed
lemma share_all_until_volatile_write_thread_local':
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_owned: "a ∈ 𝒪 ∪ all_acquired sb"
shows "share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (share_all_until_volatile_write ts 𝒮) a =
share sb 𝒮 a"
proof -
let ?take = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
let ?drop = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
from share_all_until_volatile_write_thread_local [OF dist consis i_bound ts_i a_owned]
have "share_all_until_volatile_write ts 𝒮 a = share ?take 𝒮 a" .
moreover
from share_shared_eq [of "share_all_until_volatile_write ts 𝒮" a "share ?take 𝒮", OF this]
have "share ?drop (share_all_until_volatile_write ts 𝒮) a = share ?drop (share ?take 𝒮) a" .
thus ?thesis
using share_append [of ?take ?drop 𝒮]
by simp
qed
lemma (in ownership_distinct) in_shared_sb_share_all_until_volatile_write:
assumes consis: "sharing_consis 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_owned: "a ∈ 𝒪 ∪ all_acquired sb"
assumes a_share: "a ∈ dom (share sb 𝒮)"
shows "a ∈ dom (share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
(share_all_until_volatile_write ts 𝒮))"
proof -
have dist: "ownership_distinct ts"
using assms ownership_distinct
apply -
apply (rule ownership_distinct.intro)
apply auto
done
from share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i a_owned]
a_share
show ?thesis
by (auto simp add: domIff)
qed
lemma owns_unshared_share_acquired:
"⋀𝒮 𝒪. ⟦sharing_consistent 𝒮 𝒪 sb; a ∈ 𝒪; a ∉ all_unshared sb⟧
⟹ a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
a_owns: "a ∈ 𝒪" and A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and
a_L: "a ∉ L" and a_unsh: " a ∉ all_unshared sb" and L_A: "L ⊆ A" and
A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b volatile)
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∪ acquired True sb (𝒪 ∪ A - R)"
proof (cases "a ∈ R")
case True
with a_L have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from unshared_share_in [OF this a_unsh]
show ?thesis by blast
next
case False
hence "a ∈ 𝒪 ∪ A - R"
using a_owns
by auto
from Cons.hyps [OF consis' this a_unsh]
show ?thesis .
qed
then
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_owns: "a ∈ 𝒪" and A_shared_onws: "A ⊆ dom 𝒮 ∪ 𝒪" and
a_L: "a ∉ L" and a_unsh: " a ∉ all_unshared sb" and L_A: "L ⊆ A" and
A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∪ acquired True sb (𝒪 ∪ A - R)"
proof (cases "a ∈ R")
case True
with a_L have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from unshared_share_in [OF this a_unsh]
show ?thesis by blast
next
case False
hence "a ∈ 𝒪 ∪ A - R"
using a_owns
by auto
from Cons.hyps [OF consis' this a_unsh]
show ?thesis .
qed
then show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma shared_share_acquired: "⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹
a ∈ dom 𝒮 ⟹ a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
a_shared: "a ∈ dom 𝒮" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ L")
case False with a_shared
have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from Cons.hyps [OF consis' this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case True
with L_A have a_A: "a ∈ A"
by blast
from sharing_consistent_mono_shared [OF _ consis', where 𝒮'="(𝒮 ⊕⇘W⇙ R)"]
have "sharing_consistent (𝒮 ⊕⇘W⇙ R) (𝒪 ∪ A - R) sb"
by auto
from Cons.hyps [OF this] a_shared
have hyp: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R)) ∪ acquired True sb (𝒪 ∪ A - R)"
by auto
{
assume "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R))"
from share_unshared_in [OF this]
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∪ acquired True sb (𝒪 ∪ A - R)"
proof
assume "a ∈ dom (share sb Map.empty)"
from share_mono_in [OF this]
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
thus ?thesis by blast
next
assume "a ∈ dom (𝒮 ⊕⇘W⇙ R) ∧ a ∉ all_unshared sb"
hence a_unsh: "a ∉ all_unshared sb" by blast
from a_A A_R have "a ∈ 𝒪 ∪ A - R"
by auto
from owns_unshared_share_acquired [OF consis' this a_unsh]
show ?thesis .
qed
}
with hyp show ?thesis
by (auto simp add: Write⇩s⇩b volatile)
qed
next
case False
with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_shared: "a ∈ dom 𝒮" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ L")
case False with a_shared
have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from Cons.hyps [OF consis' this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case True
with L_A have a_A: "a ∈ A"
by blast
from sharing_consistent_mono_shared [OF _ consis', where 𝒮'="(𝒮 ⊕⇘W⇙ R)"]
have "sharing_consistent (𝒮 ⊕⇘W⇙ R) (𝒪 ∪ A - R) sb"
by auto
from Cons.hyps [OF this] a_shared
have hyp: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R)) ∪ acquired True sb (𝒪 ∪ A - R)"
by auto
{
assume "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R))"
from share_unshared_in [OF this]
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∪ acquired True sb (𝒪 ∪ A - R)"
proof
assume "a ∈ dom (share sb Map.empty)"
from share_mono_in [OF this]
have "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
thus ?thesis by blast
next
assume "a ∈ dom (𝒮 ⊕⇘W⇙ R) ∧ a ∉ all_unshared sb"
hence a_unsh: "a ∉ all_unshared sb" by blast
from a_A A_R have "a ∈ 𝒪 ∪ A - R"
by auto
from owns_unshared_share_acquired [OF consis' this a_unsh]
show ?thesis .
qed
}
with hyp show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma dom_release_takeWhile:
"⋀S ℛ.
dom (release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S ℛ) =
dom ℛ ∪ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (induct sb)
apply (clarsimp)
subgoal for a sb S ℛ
apply (case_tac a)
apply (auto simp add: augment_rels_def domIff split: if_split_asm option.splits)
done
done
lemma share_all_until_volatile_write_share_acquired:
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes a_notin: "a ∉ dom 𝒮"
assumes a_in: "a ∈ dom (share_all_until_volatile_write ts 𝒮)"
shows "∃i < length ts.
let (_,_,_,sb,_,_,_) = ts!i
in a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
using dist consis a_notin a_in
proof (induct ts arbitrary: 𝒮 i)
case Nil thus ?case by simp
next
case (Cons t ts)
have a_notin: "a ∉ dom 𝒮" by fact
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
let ?take = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
from t Cons.prems
have a_in: "a ∈ dom (share_all_until_volatile_write ts (share ?take 𝒮))"
by auto
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts".
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts".
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts".
let ?𝒮' = "(share ?take 𝒮)"
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t".
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t ?take".
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired ?take ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF this]
have consis_shared': "sharing_consis ?𝒮' ts".
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases "a ∈ all_shared ?take")
case True
thus ?thesis
apply -
apply (rule_tac x=0 in exI)
apply (auto simp add: t aargh)
done
next
case False
have a_notin': "a ∉ dom ?𝒮'"
proof
assume "a ∈ dom ?𝒮'"
from share_all_shared_in [OF this] False a_notin
show False
by auto
qed
from Cons.hyps [OF dist' consis_shared' a_notin' a_in]
obtain i where "i < length ts" and
rel: "let (p,is,θ,sb,𝒟,𝒪,ℛ) = ts!i
in a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: Let_def aargh)
then show ?thesis
apply -
apply (rule_tac x = "Suc i" in exI)
apply (auto simp add: Let_def aargh)
done
qed
qed
lemma all_shared_share_acquired: "⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹
a ∈ all_shared sb ⟹ a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
a_shared: "a ∈ R ∪ all_shared sb" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ all_shared sb")
case True
from Cons.hyps [OF consis' True]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with a_shared have "a ∈ R"
by auto
with L_A A_R R_owns have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from shared_share_acquired [OF consis' this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
qed
next
case False
with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_shared: "a ∈ R ∪ all_shared sb" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ all_shared sb")
case True
from Cons.hyps [OF consis' True]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case False
with a_shared have "a ∈ R"
by auto
with L_A A_R R_owns have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from shared_share_acquired [OF consis' this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma (in ownership_distinct) share_all_until_volatile_write_share_acquired:
assumes consis: "sharing_consis 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_in: "a ∈ dom (share_all_until_volatile_write ts 𝒮)"
shows "a ∈ dom (share sb 𝒮) ∨ a ∈ acquired True sb 𝒪 ∨
(∃j < length ts. j ≠ i ∧
(let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)))"
proof -
from assms ownership_distinct have dist: "ownership_distinct ts"
apply -
apply (rule ownership_distinct.intro)
apply simp
done
from consis
interpret sharing_consis 𝒮 ts .
from sharing_consis [OF i_bound ts_i]
have consis_sb: "sharing_consistent 𝒮 𝒪 sb".
let ?take_sb = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
let ?drop_sb = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
show ?thesis
proof (cases "a ∈ dom 𝒮")
case True
from shared_share_acquired [OF consis_sb True]
have "a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪".
thus ?thesis by auto
next
case False
from share_all_until_volatile_write_share_acquired [OF dist consis False a_in]
obtain j where j_bound: "j < length ts" and
rel: "let (_,_,_,sb⇩j,_,_,_) = ts!j
in a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by auto
show ?thesis
proof (cases "j=i")
case False
with j_bound rel
show ?thesis
by blast
next
case True
with rel ts_i have "a ∈ all_shared ?take_sb"
by (auto simp add: Let_def)
hence "a ∈ all_shared sb"
using all_shared_append [of ?take_sb ?drop_sb]
by auto
from all_shared_share_acquired [OF consis_sb this]
have "a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪".
thus ?thesis
by auto
qed
qed
qed
lemma acquired_all_shared_in:
"⋀A. a ∈ acquired True sb A ⟹ a ∈ acquired True sb {} ∨ (a ∈ A ∧ a ∉ all_shared sb)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L R)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
have a_in: "a ∈ acquired True sb (A ∪ A' - R)"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ A")
case True
from Cons.hyps [OF a_in]
have "a ∈ acquired True sb {} ∨ a ∈ A ∪ A' - R ∧ a ∉ all_shared sb".
then show ?thesis
proof
assume "a ∈ acquired True sb {}"
from acquired_mono_in [OF this]
have "a ∈ acquired True sb (A' - R)" by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile True)
next
assume "a ∈ A ∪ A' - R ∧ a ∉ all_shared sb"
then obtain "a ∉ R" "a ∉ all_shared sb"
by blast
then show ?thesis by (clarsimp simp add: Write⇩s⇩b volatile True)
qed
next
case False
have "(A ∪ A' - R) ⊆ A ∪ (A' - R)"
by blast
from acquired_mono [OF this] a_in
have "a ∈ acquired True sb (A ∪ (A' - R))" by blast
from acquired_union_notin_first [OF this False]
have "a ∈ acquired True sb (A' - R)".
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A' L R W)
from Cons.prems
have a_in: "a ∈ acquired True sb (A ∪ A' - R)"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ A")
case True
from Cons.hyps [OF a_in]
have "a ∈ acquired True sb {} ∨ a ∈ A ∪ A' - R ∧ a ∉ all_shared sb".
then show ?thesis
proof
assume "a ∈ acquired True sb {}"
from acquired_mono_in [OF this]
have "a ∈ acquired True sb (A' - R)" by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b True)
next
assume "a ∈ A ∪ A' - R ∧ a ∉ all_shared sb"
then obtain "a ∉ R" "a ∉ all_shared sb"
by blast
then show ?thesis by (clarsimp simp add: Ghost⇩s⇩b True)
qed
next
case False
have "(A ∪ A' - R) ⊆ A ∪ (A' - R)"
by blast
from acquired_mono [OF this] a_in
have "a ∈ acquired True sb (A ∪ (A' - R))" by blast
from acquired_union_notin_first [OF this False]
have "a ∈ acquired True sb (A' - R)".
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma all_shared_acquired_in: "⋀A. a ∈ A ⟹ a ∉ all_shared sb ⟹ a ∈ acquired True sb A"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A' L R W)
show ?thesis
proof (cases volatile)
case True
show ?thesis
proof -
from Cons.prems obtain a_A: "a ∈ A" and a_R: "a ∉ R" and a_sb: "a ∉ all_shared sb"
by (clarsimp simp add: Write⇩s⇩b True)
from a_A a_R have "a ∈ A ∪ A' - R"
by blast
from Cons.hyps [OF this a_sb]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Ghost⇩s⇩b
with Cons show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma owned_share_acquired: "⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹
a ∈ 𝒪 ⟹ a ∈ dom (share sb 𝒮) ∪ acquired True sb 𝒪"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
a_owned: "a ∈ 𝒪" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ R")
case False with a_owned
have "a ∈ 𝒪 ∪ A - R"
by auto
from Cons.hyps [OF consis' this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case True
from True L_A A_R have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from shared_share_acquired [OF consis' this]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile True)
qed
next
case False
with Cons
show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_owned: "a ∈ 𝒪" and A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ R")
case False with a_owned
have "a ∈ 𝒪 ∪ A - R"
by auto
from Cons.hyps [OF consis' this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case True
from True L_A A_R have "a ∈ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from shared_share_acquired [OF consis' this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b True)
qed
qed
qed
lemma outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired:
"⋀m 𝒮 𝒪 pending_write.
⟦reads_consistent pending_write 𝒪 m sb;non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb⟧
⟹ a ∈ 𝒪 ∨ a ∈ all_acquired sb ∨
a ∈ read_only_reads 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
non_vo: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
(𝒪 ∪ A - R) sb" and
out_vol: "outstanding_refs is_volatile_Read⇩s⇩b sb = {}" and
out: "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ 𝒪")
case True
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True volatile)
next
case False
from outstanding_non_volatile_Read⇩s⇩b_acquired_or_read_only_reads [OF non_vo out]
have a_in: "a ∈ acquired_reads True sb (𝒪 ∪ A - R) ∨
a ∈ read_only_reads (𝒪 ∪ A - R) sb"
by auto
with acquired_reads_all_acquired [of True sb "(𝒪 ∪ A - R)"]
show ?thesis
by (auto simp add: Write⇩s⇩b volatile)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
apply (clarsimp simp del: o_apply simp add: Read⇩s⇩b
acquired_takeWhile_non_volatile_Write⇩s⇩b split: if_split_asm)
apply auto
done
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L)
with Cons show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired_dropWhile:
assumes consis: "reads_consistent pending_write 𝒪 m sb"
assumes nvo: "non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb"
assumes out: "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
shows "a ∈ 𝒪 ∨ a ∈ all_acquired sb ∨
a ∈ read_only_reads 𝒪 sb"
using outstanding_refs_append [of is_non_volatile_Read⇩s⇩b "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"]
outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired [OF consis nvo, of a] out
by (auto)
lemma share_commute:
"⋀L R 𝒮 𝒪. ⟦sharing_consistent 𝒮 𝒪 sb;
all_shared sb ∩ L = {}; all_shared sb ∩ A = {}; all_acquired sb ∩ R = {};
all_unshared sb ∩ R = {}; all_shared sb ∩ R = {}⟧ ⟹
(share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) =
(share sb 𝒮) ⊕⇘W⇙ R ⊖⇘A⇙ L"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A' L' R' W')
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
L_prop: "(R' ∪ all_shared sb) ∩ L = {}" and
A_prop: "(R' ∪ all_shared sb) ∩ A = {}" and
R_acq_prop: "(A' ∪ all_acquired sb) ∩ R = {}" and
R_prop:"(L' ∪ all_unshared sb) ∩ R = {}" and
R_prop_sh: "(R' ∪ all_shared sb) ∩ R = {}" and
A'_shared_owns: "A' ⊆ dom 𝒮 ∪ 𝒪" and L'_A': " L' ⊆ A'" and A'_R': "A' ∩ R' = {}" and
R'_owns: "R' ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') (𝒪 ∪ A' - R') sb"
by (clarsimp simp add: Write⇩s⇩b volatile)
from L_prop obtain R'_L: "R' ∩ L = {}" and acq_L: "all_shared sb ∩ L = {}"
by blast
from A_prop obtain R'_A: "R' ∩ A = {}" and acq_A: "all_shared sb ∩ A = {}"
by blast
from R_acq_prop obtain A'_R: "A' ∩ R = {}" and acq_R:"all_acquired sb ∩ R = {}"
by blast
from R_prop obtain L'_R: "L' ∩ R = {}" and unsh_R: "all_unshared sb ∩ R = {}"
by blast
from R_prop_sh obtain R'_R: "R' ∩ R = {}" and sh_R: "all_shared sb ∩ R = {}"
by blast
from Cons.hyps [OF consis' acq_L acq_A acq_R unsh_R sh_R ]
have "share sb ((𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L) = share sb (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L".
moreover
from R'_L L'_R R'_R R'_A A'_R
have "((𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') = ((𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply -
apply (rule ext)
apply (clarsimp simp add: augment_shared_def restrict_shared_def)
apply (auto split: if_split_asm option.splits)
done
ultimately
have "share sb ((𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') = share sb (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L"
by simp
then
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False with Cons show ?thesis
by (clarsimp simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by (clarsimp simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b with Cons show ?thesis
by (clarsimp simp add: Prog⇩s⇩b)
next
case (Ghost⇩s⇩b A' L' R' W')
from Cons.prems obtain
L_prop: "(R' ∪ all_shared sb) ∩ L = {}" and
A_prop: "(R' ∪ all_shared sb) ∩ A = {}" and
R_acq_prop: "(A' ∪ all_acquired sb) ∩ R = {}" and
R_prop:"(L' ∪ all_unshared sb) ∩ R = {}" and
R_prop_sh: "(R' ∪ all_shared sb) ∩ R = {}" and
A'_shared_owns: "A' ⊆ dom 𝒮 ∪ 𝒪" and L'_A': " L' ⊆ A'" and A'_R': "A' ∩ R' = {}" and
R'_owns: "R' ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') (𝒪 ∪ A' - R') sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from L_prop obtain R'_L: "R' ∩ L = {}" and acq_L: "all_shared sb ∩ L = {}"
by blast
from A_prop obtain R'_A: "R' ∩ A = {}" and acq_A: "all_shared sb ∩ A = {}"
by blast
from R_acq_prop obtain A'_R: "A' ∩ R = {}" and acq_R:"all_acquired sb ∩ R = {}"
by blast
from R_prop obtain L'_R: "L' ∩ R = {}" and unsh_R: "all_unshared sb ∩ R = {}"
by blast
from R_prop_sh obtain R'_R: "R' ∩ R = {}" and sh_R: "all_shared sb ∩ R = {}"
by blast
from Cons.hyps [OF consis' acq_L acq_A acq_R unsh_R sh_R ]
have "share sb ((𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L) = share sb (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L".
moreover
from R'_L L'_R R'_R R'_A A'_R
have "((𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') = ((𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply -
apply (rule ext)
apply (clarsimp simp add: augment_shared_def restrict_shared_def)
apply (auto split: if_split_asm option.splits)
done
ultimately
have "share sb ((𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') = share sb (𝒮 ⊕⇘W'⇙ R' ⊖⇘A'⇙ L') ⊕⇘W⇙ R ⊖⇘A⇙ L"
by simp
then
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_all_until_volatile_write_commute:
"⋀ 𝒮 R L. ⟦ownership_distinct ts; sharing_consis 𝒮 ts;
∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {};
∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {};
∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {};
∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {};
∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}⟧
⟹
share_all_until_volatile_write ts 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L = share_all_until_volatile_write ts (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p "is" 𝒪 ℛ 𝒟 θ sb where
t: "t=(p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts".
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts".
have L_prop: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts) ⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}" by fact
hence L_prop': "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (ts) ⟶ (ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
by force
have A_prop: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts) ⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}" by fact
hence A_prop': "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (ts) ⟶ (ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
by force
have R_prop_acq: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts) ⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
hence R_prop_acq': "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (ts) ⟶ (ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by force
have R_prop: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts) ⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
hence R_prop': "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (ts) ⟶ (ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by force
have R_prop_sh: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts) ⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
hence R_prop_sh': "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (ts) ⟶ (ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by force
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts".
from L_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t
have sh_L: "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
by simp
from A_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t
have sh_A: "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
by simp
from R_prop_acq [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t
have acq_R: "all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by simp
from R_prop [rule_format, of 0 p "is" θ sb 𝒟 𝒪 ] t
have unsh_R: "all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by simp
from R_prop_sh [rule_format, of 0 p "is" θ sb 𝒟 𝒪] t
have sh_R: "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
by simp
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪 sb".
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)".
from share_commute [OF consis_sb sh_L sh_A acq_R unsh_R sh_R]
have share_eq:
"(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) =
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮) ⊕⇘W⇙ R ⊖⇘A⇙ L".
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ 𝒪"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have sharing_consis': "sharing_consis (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮) ts".
from Cons.hyps [OF dist' sharing_consis' L_prop' A_prop' R_prop_acq' R_prop' R_prop_sh']
have "share_all_until_volatile_write ts ?𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L =
share_all_until_volatile_write ts (?𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)".
then
have "share_all_until_volatile_write ts
?𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L =
share_all_until_volatile_write ts
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (simp add: share_eq)
then
show ?case
by (simp add: t)
qed
lemma share_append_Ghost⇩s⇩b:
"⋀𝒮. outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹ (share (sb @ [Ghost⇩s⇩b A L R W]) 𝒮) = (share sb 𝒮) ⊕⇘W⇙ R ⊖⇘A⇙ L"
apply (induct sb)
apply simp
subgoal for a sb 𝒮
apply (case_tac a)
apply auto
done
done
lemma share_append_Ghost⇩s⇩b':
"⋀𝒮. outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {} ⟹
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Ghost⇩s⇩b A L R W])) 𝒮) =
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
apply (induct sb)
apply simp
subgoal for a sb 𝒮
apply (case_tac a)
apply force+
done
done
lemma share_all_until_volatile_write_append_Ghost⇩s⇩b:
assumes no_out_VWrite⇩s⇩b: "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
shows "⋀𝒮 i. ⟦ownership_distinct ts; sharing_consis 𝒮 ts;
i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {};
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {};
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {};
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {};
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}⟧
⟹
share_all_until_volatile_write (ts[i := (p', is',θ', sb @ [Ghost⇩s⇩b A L R W], 𝒟', 𝒪')]) 𝒮
= share_all_until_volatile_write ts 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t acq⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts".
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts".
have L_prop: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j ⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}" by fact
have A_prop: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j ⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}" by fact
have R_prop_acq: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
have R_prop: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
have R_prop_sh: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j ⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by fact
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts".
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t" .
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)".
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)"
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i acq⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have sharing_consis': "sharing_consis (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮) ts".
show ?case
proof (cases i)
case 0
with t Cons.prems have eqs: "p⇩t=p" "is⇩t=is" "𝒪⇩t=𝒪" "ℛ⇩t=ℛ" "θ⇩t=θ" "sb⇩t=sb" "𝒟⇩t=𝒟"
by auto
from no_out_VWrite⇩s⇩b
have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from no_out_VWrite⇩s⇩b
have flush_all': "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@[Ghost⇩s⇩b A L R W]) = sb@[Ghost⇩s⇩b A L R W]"
by (auto simp add: outstanding_refs_conv)
have share_eq:
"(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Ghost⇩s⇩b A L R W])) 𝒮) =
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮) ⊕⇘W⇙ R ⊖⇘A⇙ L"
apply (simp only: flush_all flush_all')
apply (rule share_append_Ghost⇩s⇩b [OF no_out_VWrite⇩s⇩b])
done
from L_prop 0 have L_prop':
"∀i p is 𝒪 ℛ 𝒟 θ sb.
i < length ts ⟶
ts ! i = (p, is,θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
apply clarsimp
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply auto
done
done
from A_prop 0 have A_prop':
"∀i p is 𝒪 ℛ 𝒟 θ sb.
i < length ts ⟶
ts ! i = (p, is,θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
apply clarsimp
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply auto
done
done
from R_prop_acq 0 have R_prop_acq':
"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
apply clarsimp
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply auto
done
done
from R_prop 0
have R_prop':
"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
apply clarsimp
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply auto
done
done
from R_prop_sh 0 have R_prop_sh':
"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts ⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
apply clarsimp
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply auto
done
done
from share_all_until_volatile_write_commute [OF dist' sharing_consis' L_prop' A_prop' R_prop_acq' R_prop'
R_prop_sh']
have "share_all_until_volatile_write ts (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) =
share_all_until_volatile_write ts (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮) ⊕⇘W⇙ R ⊖⇘A⇙ L"
by (simp add: eqs)
with share_eq
show ?thesis
by (clarsimp simp add: 0 t)
next
case (Suc k)
from L_prop Suc
have L_prop': "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (ts) ⟶ k≠j ⟶ (ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}" by force
from A_prop Suc
have A_prop': "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (ts) ⟶ k≠j ⟶ (ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}" by force
from R_prop_acq Suc have R_prop_acq':
"∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ k≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by force
from R_prop Suc
have R_prop':
"∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ k≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by force
from R_prop_sh Suc have R_prop_sh':
"∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ k≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}" by force
from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k = (p, is,θ, sb, 𝒟, 𝒪,ℛ)"
by auto
from Cons.hyps [OF dist' sharing_consis' k_bound ts_k L_prop' A_prop' R_prop_acq' R_prop' R_prop_sh']
show ?thesis
by (clarsimp simp add: t Suc)
qed
qed
lemma share_domain_changes:
"⋀𝒮 𝒮'. a ∈ all_shared sb ∪ all_unshared sb ⟹ share sb 𝒮' a = share sb 𝒮 a "
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain a_in: "a ∈ R ∪ all_shared sb ∪ L ∪ all_unshared sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ R")
case True
from True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
note not_R = this
show ?thesis
proof (cases "a ∈ L")
case True
from not_R True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with not_R a_in have "a ∈ all_shared sb ∪ all_unshared sb"
by auto
from Cons.hyps [OF this]
show ?thesis by (clarsimp simp add: Write⇩s⇩b volatile)
qed
qed
next
case False with Cons show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (auto)
next
case Prog⇩s⇩b with Cons show ?thesis by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain a_in: "a ∈ R ∪ all_shared sb ∪ L ∪ all_unshared sb"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ R")
case True
from True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case False
note not_R = this
show ?thesis
proof (cases "a ∈ L")
case True
from not_R True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case False
with not_R a_in have "a ∈ all_shared sb ∪ all_unshared sb"
by auto
from Cons.hyps [OF this]
show ?thesis by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
qed
qed
lemma share_domain_changesX:
"⋀𝒮 𝒮' X. ∀a ∈ X. 𝒮' a = 𝒮 a
⟹ a ∈ all_shared sb ∪ all_unshared sb ∪ X ⟹ share sb 𝒮' a = share sb 𝒮 a "
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
then have shared_eq: "∀a ∈ X. 𝒮' a = 𝒮 a"
by auto
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain a_in: "a ∈ R ∪ all_shared sb ∪ L ∪ all_unshared sb ∪ X"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ R")
case True
from True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
note not_R = this
show ?thesis
proof (cases "a ∈ L")
case True
from not_R True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
from shared_eq have shared_eq': "∀a ∈ X. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from False not_R a_in have "a ∈ all_shared sb ∪ all_unshared sb ∪ X"
by auto
from Cons.hyps [OF shared_eq' this]
show ?thesis by (clarsimp simp add: Write⇩s⇩b volatile)
qed
qed
next
case False with Cons show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (auto)
next
case Prog⇩s⇩b with Cons show ?thesis by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain a_in: "a ∈ R ∪ all_shared sb ∪ L ∪ all_unshared sb ∪ X"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ R")
case True
from True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case False
note not_R = this
show ?thesis
proof (cases "a ∈ L")
case True
from not_R True have "(𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from share_shared_eq [where 𝒮'="𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L" and 𝒮="𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L", OF this]
have "share sb (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by auto
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case False
from shared_eq have shared_eq': "∀a ∈ X. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
from False not_R a_in have "a ∈ all_shared sb ∪ all_unshared sb ∪ X"
by auto
from Cons.hyps [OF shared_eq' this]
show ?thesis by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
qed
qed
lemma share_unchanged:
"⋀𝒮. a ∉ all_shared sb ∪ all_unshared sb ∪ all_acquired sb ⟹ share sb 𝒮 a = 𝒮 a "
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain a_R: "a ∉ R" and a_L: "a ∉ L" and a_A: "a ∉ A"
and a': "a ∉ all_shared sb ∪ all_unshared sb ∪ all_acquired sb"
by (clarsimp simp add: Write⇩s⇩b True)
from Cons.hyps [OF a']
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a" .
moreover
from a_R a_L a_A have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
ultimately
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (auto)
next
case Prog⇩s⇩b with Cons show ?thesis by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain a_R: "a ∉ R" and a_L: "a ∉ L" and a_A: "a ∉ A"
and a': "a ∉ all_shared sb ∪ all_unshared sb ∪ all_acquired sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from Cons.hyps [OF a']
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a" .
moreover
from a_R a_L a_A have "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
ultimately
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_augment_release_commute:
assumes dist: "(R ∪ L ∪ A) ∩ (all_shared sb ∪ all_unshared sb ∪ all_acquired sb) = {}"
shows "(share sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof -
from dist have shared_eq: "∀a ∈ all_acquired sb. (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = 𝒮 a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
{
fix a
assume a_in: "a ∈ all_shared sb ∪ all_unshared sb ∪ all_acquired sb"
from share_domain_changesX [OF shared_eq this]
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = share sb 𝒮 a".
also
from dist a_in have "... = (share sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
finally have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (share sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a".
}
moreover
{
fix a
assume a_notin: "a ∉ all_shared sb ∪ all_unshared sb ∪ all_acquired sb"
from share_unchanged [OF a_notin]
have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a".
moreover
from share_unchanged [OF a_notin]
have "share sb 𝒮 a = 𝒮 a".
hence "(share sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
ultimately have "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (share sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by simp
}
ultimately show ?thesis
apply -
apply (rule ext)
subgoal for x
apply (case_tac "x ∈ all_shared sb ∪ all_unshared sb ∪ all_acquired sb")
apply auto
done
done
qed
lemma share_append_commute:
"⋀ys 𝒮. (all_shared xs ∪ all_unshared xs ∪ all_acquired xs) ∩
(all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {}
⟹ share xs (share ys 𝒮) = share ys (share xs 𝒮)"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems have
dist': "(all_shared xs ∪ all_unshared xs ∪ all_acquired xs) ∩
(all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {} "
apply (clarsimp simp add: Write⇩s⇩b True)
apply blast
done
from Cons.prems have
dist: "(R ∪ L ∪ A) ∩ (all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {}"
apply (clarsimp simp add: Write⇩s⇩b True)
apply blast
done
from share_augment_release_commute [OF dist]
have "(share ys 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = share ys (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
with Cons.hyps [OF dist']
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (clarsimp simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems have
dist': "(all_shared xs ∪ all_unshared xs ∪ all_acquired xs) ∩
(all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {} "
apply (clarsimp simp add: Ghost⇩s⇩b)
apply blast
done
from Cons.prems have
dist: "(R ∪ L ∪ A) ∩ (all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {}"
apply (clarsimp simp add: Ghost⇩s⇩b)
apply blast
done
from share_augment_release_commute [OF dist]
have "(share ys 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = share ys (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
with Cons.hyps [OF dist']
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma share_append_commute':
assumes dist: "(all_shared xs ∪ all_unshared xs ∪ all_acquired xs) ∩
(all_shared ys ∪ all_unshared ys ∪ all_acquired ys) = {} "
shows "share (ys@xs) 𝒮 = share (xs@ys) 𝒮"
proof -
from share_append_commute [OF dist] share_append [of xs ys] share_append [of ys xs]
show ?thesis
by simp
qed
lemma share_all_until_volatile_write_share_commute:
shows "⋀ 𝒮 (sb'::'a memref list). ⟦ownership_distinct ts; sharing_consis 𝒮 ts;
∀i p is 𝒪 ℛ 𝒟 θ (sb::'a memref list). i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared sb' ∪ all_unshared sb' ∪ all_acquired sb') = {}⟧
⟹
share_all_until_volatile_write ts (share sb' 𝒮) =
share sb' (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
let ?take = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts" .
have dist_prop: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts)
⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared sb' ∪ all_unshared sb' ∪ all_acquired sb') = {}" by fact
from dist_prop [rule_format, of 0] t
have dist_t: "(all_shared ?take ∪ all_unshared ?take ∪ all_acquired ?take) ∩
(all_shared sb' ∪ all_unshared sb' ∪ all_acquired sb') = {}"
apply clarsimp
done
from dist_prop have
dist_prop':"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared sb' ∪ all_unshared sb' ∪ all_acquired sb') = {}"
apply (clarsimp)
subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i" in spec)
apply clarsimp
done
done
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts" .
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t" .
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t ?take".
let ?𝒮' = "(share ?take 𝒮)"
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i acq⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have sharing_consis': "sharing_consis ?𝒮' ts".
have "share_all_until_volatile_write ts (share ?take (share sb' 𝒮)) =
share sb' (share_all_until_volatile_write ts (share ?take 𝒮))"
proof -
from share_append_commute [OF dist_t]
have "(share ?take (share sb' 𝒮)) = (share sb' (share ?take 𝒮))" .
then
have "share_all_until_volatile_write ts (share ?take (share sb' 𝒮)) =
share_all_until_volatile_write ts (share sb' (share ?take 𝒮))"
by (simp)
also
from Cons.hyps [OF dist' sharing_consis' dist_prop']
have "... = share sb' (share_all_until_volatile_write ts (share ?take 𝒮))".
finally show ?thesis .
qed
then show ?case
by (clarsimp simp add: t)
qed
lemma all_shared_takeWhile_subset: "all_shared (takeWhile P sb) ⊆ all_shared sb"
using all_shared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma all_shared_dropWhile_subset: "all_shared (dropWhile P sb) ⊆ all_shared sb"
using all_shared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma all_unshared_takeWhile_subset: "all_unshared (takeWhile P sb) ⊆ all_unshared sb"
using all_unshared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma all_unshared_dropWhile_subset: "all_unshared (dropWhile P sb) ⊆ all_unshared sb"
using all_unshared_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma all_acquired_takeWhile_subset: "all_acquired (takeWhile P sb) ⊆ all_acquired sb"
using all_acquired_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma all_acquired_dropWhile_subset: "all_acquired (dropWhile P sb) ⊆ all_acquired sb"
using all_acquired_append [of "(takeWhile P sb)" "(dropWhile P sb)"]
by auto
lemma share_all_until_volatile_write_flush_commute:
assumes takeWhile_empty: "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) = []"
shows "⋀ 𝒮 R L W A i. ⟦ownership_distinct ts; sharing_consis 𝒮 ts; i < length ts;
ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ);
∀i p is 𝒪 ℛ 𝒟 θ (sb::'a memref list). i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')) = {};
∀j p is 𝒪 ℛ 𝒟 θ (sb::'a memref list). j < length ts ⟶ i≠j
⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared sb ∪ all_unshared sb ∪ all_acquired sb) ∩
(R ∪ L ∪ A) = {}⟧
⟹
share_all_until_volatile_write (ts[i :=(p',is',θ',sb',𝒟',𝒪',ℛ')]) (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (share_all_until_volatile_write ts 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
let ?take = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
let ?take_sb' = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
let ?drop = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts" .
have dist_prop: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length (t#ts)
⟶ (t#ts)!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared ?take_sb' ∪ all_unshared ?take_sb' ∪ all_acquired ?take_sb') = {}" by fact
from dist_prop [rule_format, of 0] t
have dist_t: "(all_shared ?take ∪ all_unshared ?take ∪ all_acquired ?take) ∩
(all_shared ?take_sb' ∪ all_unshared ?take_sb' ∪ all_acquired ?take_sb') = {}"
apply clarsimp
done
from dist_prop have
dist_prop':"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared ?take_sb' ∪ all_unshared ?take_sb' ∪ all_acquired ?take_sb') = {}"
apply (clarsimp)
subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i" in spec)
apply clarsimp
done
done
have dist_prop_R_L_A: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i ≠ j
⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared sb ∪ all_unshared sb ∪ all_acquired sb) ∩
(R ∪ L ∪ A) = {}" by fact
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts" .
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t" .
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)".
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases i)
case 0
with t Cons.prems have eqs: "p⇩t=p" "is⇩t=is" "𝒪⇩t=𝒪" "ℛ⇩t=ℛ" "θ⇩t=θ" "sb⇩t=sb" "𝒟⇩t=𝒟"
by auto
let ?𝒮' = "𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"
from dist_prop_R_L_A 0 have
dist_prop_R_L_A':"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared sb ∪ all_unshared sb ∪ all_acquired sb) ∩
(R ∪ L ∪ A) = {}"
apply (clarsimp)
subgoal for i1 p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc i1" in spec)
apply clarsimp
done
done
then
have dist_prop_R_L_A'':"∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts
⟶ ts!i=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(R ∪ L ∪ A) = {}"
apply (clarsimp)
subgoal for i p "is" 𝒪 ℛ 𝒟 θ sb
apply (cut_tac sb=sb in all_shared_takeWhile_subset [where P="Not ∘ is_volatile_Write⇩s⇩b"])
apply (cut_tac sb=sb in all_unshared_takeWhile_subset [where P="Not ∘ is_volatile_Write⇩s⇩b"])
apply (cut_tac sb=sb in all_acquired_takeWhile_subset [where P="Not ∘ is_volatile_Write⇩s⇩b" ])
apply fastforce
done
done
have sep: "∀i<length ts.
let (_, _, _, sb, _, _, _) = ts ! i
in ∀a∈all_acquired sb. ?𝒮' a = 𝒮 a"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i acq⇩i θ⇩i sb⇩i a
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
assume a_in: "a ∈ all_acquired sb⇩i"
have "?𝒮' a = 𝒮 a"
proof -
from dist_prop_R_L_A' [rule_format, OF i_bound ts_i] a_in
show ?thesis
by (auto simp add: augment_shared_def restrict_shared_def split: option.splits)
qed
}
thus ?thesis by auto
qed
from consis'.sharing_consis_shared_exchange [OF sep]
have sharing_consis': "sharing_consis ?𝒮' ts".
from share_all_until_volatile_write_share_commute [of ts "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')", OF dist' sharing_consis' dist_prop']
have "share_all_until_volatile_write ts (share ?take_sb' ?𝒮') =
share ?take_sb' (share_all_until_volatile_write ts ?𝒮')" .
moreover
from dist_prop_R_L_A''
have "(share_all_until_volatile_write ts (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) =
(share_all_until_volatile_write ts 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply -
apply (rule share_all_until_volatile_write_commute [OF dist' consis', of L A R W,symmetric])
apply (clarsimp,blast)+
done
ultimately
show ?thesis
using takeWhile_empty
by (clarsimp simp add: t 0 aargh eqs)
next
case (Suc k)
from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k = (p, is,θ, sb, 𝒟, 𝒪,ℛ)"
by auto
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)"
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i acq⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have sharing_consis': "sharing_consis ?𝒮' ts".
from dist_prop_R_L_A [rule_format, of 0] Suc t
have dist_t_R_L_A: "(all_shared sb⇩t ∪ all_unshared sb⇩t ∪ all_acquired sb⇩t) ∩
(R ∪ L ∪ A) = {}"
apply clarsimp
done
from dist_t_R_L_A
have "(R ∪ L ∪ A) ∩ (all_shared ?take ∪ all_unshared ?take ∪ all_acquired ?take) = {}"
using all_shared_append [of ?take ?drop] all_unshared_append [of ?take ?drop] all_acquired_append [of ?take ?drop]
by auto
from share_augment_release_commute [OF this]
have "share ?take 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L = share ?take (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" .
moreover
from dist_prop_R_L_A Suc
have "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (ts) ⟶ k ≠ j
⟶ (ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared sb ∪ all_unshared sb ∪ all_acquired sb) ∩
(R ∪ L ∪ A) = {}"
apply (clarsimp)
subgoal for j p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc j" in spec)
apply clarsimp
done
done
note Cons.hyps [OF dist' sharing_consis' k_bound ts_k dist_prop' this, of W]
ultimately
show ?thesis
by (clarsimp simp add: t Suc )
qed
qed
lemma share_all_until_volatile_write_Ghost⇩s⇩b_commute:
shows "⋀ 𝒮 i. ⟦ownership_distinct ts; sharing_consis 𝒮 ts; i < length ts;
ts!i = (p,is,θ,Ghost⇩s⇩b A L R W#sb,𝒟,𝒪,ℛ);
∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ i≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(R ∪ L ∪ A) = {}⟧
⟹
share_all_until_volatile_write (ts[i :=(p',is',θ',sb,𝒟',𝒪',ℛ')]) (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) =
share_all_until_volatile_write ts 𝒮"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
have consis: "sharing_consis 𝒮 (t#ts)" by fact
then interpret sharing_consis 𝒮 "t#ts" .
have dist_prop: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length (t#ts) ⟶ i≠j ⟶ (t#ts)!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(R ∪ L ∪ A) = {}" by fact
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
from sharing_consis_tl [OF consis]
have consis': "sharing_consis 𝒮 ts".
then
interpret consis': sharing_consis 𝒮 "ts" .
from sharing_consis [of 0, simplified, OF t]
have "sharing_consistent 𝒮 𝒪⇩t sb⇩t" .
from sharing_consistent_takeWhile [OF this]
have consis_sb: "sharing_consistent 𝒮 𝒪⇩t (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)".
let ?𝒮' = "(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)"
from freshly_shared_owned [OF consis_sb]
have fresh_owned: "dom ?𝒮' - dom 𝒮 ⊆ 𝒪⇩t".
from unshared_all_unshared [OF consis_sb] unshared_acquired_or_owned [OF consis_sb]
have unshared_acq_owned: "dom 𝒮 - dom ?𝒮'
⊆ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ 𝒪⇩t"
by simp
have sep:
"∀i < length ts. let (_,_,_,sb',_,_,_) = ts!i in
all_acquired sb' ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb' ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
{
fix i p⇩i "is⇩i" 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p⇩i,is⇩i,θ⇩i,sb⇩i,𝒟⇩i,𝒪⇩i,ℛ⇩i)"
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {} ∧
all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
proof -
from ownership_distinct [of "0" "Suc i"] ts_i t i_bound
have dist: "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩i ∪ all_acquired sb⇩i) = {}"
by force
from dist unshared_acq_owned all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩t]
have "all_acquired sb⇩i ∩ dom 𝒮 - dom ?𝒮' = {}"
by blast
moreover
from sharing_consis [of "Suc i"] ts_i i_bound
have "sharing_consistent 𝒮 𝒪⇩i sb⇩i"
by force
from unshared_acquired_or_owned [OF this]
have "all_unshared sb⇩i ⊆ all_acquired sb⇩i ∪ 𝒪⇩i".
with dist fresh_owned
have "all_unshared sb⇩i ∩ dom ?𝒮' - dom 𝒮 = {}"
by blast
ultimately show ?thesis by simp
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from consis'.sharing_consis_preservation [OF sep]
have sharing_consis': "sharing_consis (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮) ts".
show ?case
proof (cases i)
case 0
with t Cons.prems have eqs: "p⇩t=p" "is⇩t=is" "𝒪⇩t=𝒪" "ℛ⇩t=ℛ" "θ⇩t=θ" "sb⇩t=Ghost⇩s⇩b A L R W#sb" "𝒟⇩t=𝒟"
by auto
show ?thesis
by (clarsimp simp add: 0 t eqs)
next
case (Suc k)
from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k = (p, is,θ, Ghost⇩s⇩b A L R W#sb, 𝒟, 𝒪,ℛ)"
by auto
from dist_prop Suc
have dist_prop': "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts ⟶ k≠j ⟶ ts!j=(p,is,θ,sb,𝒟,𝒪,ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(R ∪ L ∪ A) = {}"
apply (clarsimp)
subgoal for j p "is" 𝒪 ℛ 𝒟 θ sb
apply (drule_tac x="Suc j" in spec)
apply auto
done
done
from Cons.hyps [OF dist' sharing_consis' k_bound ts_k dist_prop']
have "share_all_until_volatile_write (ts[k := (p', is', θ', sb, 𝒟', 𝒪', ℛ')])
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) =
share_all_until_volatile_write ts
(share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮)" .
moreover
from dist_prop [rule_format, of 0 p⇩t "is⇩t" θ⇩t sb⇩t 𝒟⇩t 𝒪⇩t ℛ⇩t ] t Suc
have "(R ∪ L ∪ A) ∩ (all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)) = {}"
apply clarsimp
apply blast
done
from share_augment_release_commute [OF this]
have "share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t) (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
ultimately
show ?thesis
by (clarsimp simp add: Suc t)
qed
qed
lemma share_all_until_volatile_write_update_sb:
assumes congr: "⋀S. share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') S = share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S"
shows "⋀𝒮 i. ⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹
share_all_until_volatile_write ts 𝒮 =
share_all_until_volatile_write (ts[i := (p', is',θ', sb', 𝒟', 𝒪',ℛ')]) 𝒮"
proof (induct ts)
case Nil
thus ?case by simp
next
case (Cons t ts)
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t where
t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
show ?case
proof (cases i)
case 0
with t Cons.prems have eqs: "p⇩t=p" "is⇩t=is" "𝒪⇩t=𝒪" "ℛ⇩t=ℛ" "θ⇩t=θ" "sb⇩t=sb" "𝒟⇩t=𝒟"
by auto
show ?thesis
by (clarsimp simp add: 0 t eqs congr)
next
case (Suc k)
from Cons.prems Suc obtain k_bound: "k < length ts" and ts_k: "ts!k = (p, is,θ, sb, 𝒟, 𝒪, ℛ)"
by auto
from Cons.hyps [OF k_bound ts_k ]
show ?thesis
by (clarsimp simp add: t Suc)
qed
qed
lemma share_all_until_volatile_write_append_Ghost⇩s⇩b':
assumes out_VWrite⇩s⇩b: "outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
shows "share_all_until_volatile_write ts 𝒮 =
share_all_until_volatile_write
(ts[i := (p', is',θ', sb @ [Ghost⇩s⇩b A L R W], 𝒟', 𝒪',ℛ')]) 𝒮"
proof -
from out_VWrite⇩s⇩b
have "⋀S. share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Ghost⇩s⇩b A L R W])) S =
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S"
by (simp add: outstanding_vol_write_takeWhile_append)
from share_all_until_volatile_write_update_sb [OF this i_bound ts_i]
show ?thesis
by simp
qed
lemma acquired_append_Prog⇩s⇩b:
"⋀S. (acquired pending_write (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])) S) =
(acquired pending_write (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S) "
by (induct sb) (auto split: memref.splits)
lemma outstanding_refs_non_empty_dropWhile:
"outstanding_refs P xs ≠ {} ⟹ outstanding_refs P (dropWhile (Not ∘ P) xs) ≠ {}"
apply (induct xs)
apply simp
apply (simp split: if_split_asm)
done
lemma ex_not: "Ex Not"
by blast
lemma (in computation) concurrent_step_append:
assumes step: "(ts,m,𝒮) ⇒ (ts',m',𝒮')"
shows "(xs@ts,m,𝒮) ⇒ (xs@ts',m',𝒮')"
using step
proof (cases)
case (Program i p "is" θ sb 𝒟 𝒪 ℛ p' is' )
then obtain
i_bound: "i < length ts" and
ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
prog_step: "θ⊢p →⇩p (p',is')" and
ts': "ts'=ts[i:=(p',is@is',θ,record p p' is' sb,𝒟,𝒪,ℛ)]" and
𝒮': "𝒮'=𝒮" and
m': "m'=m"
by auto
from i_bound have i_bound': "i + length xs < length (xs@ts)"
by auto
from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (auto simp add: nth_append)
from concurrent_step.Program [OF i_bound' ts_i' prog_step, of m 𝒮 ] ts' i_bound
show ?thesis
by (auto simp add: ts' list_update_append 𝒮' m')
next
case (Memop i p "is" θ sb 𝒟 𝒪 ℛ is' θ' sb' 𝒟' 𝒪' ℛ' )
then obtain
i_bound: "i < length ts" and
ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
memop_step: "(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩m (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')" and
ts': "ts'=ts[i:=(p,is',θ',sb',𝒟',𝒪',ℛ')]"
by auto
from i_bound have i_bound': "i + length xs < length (xs@ts)"
by auto
from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (auto simp add: nth_append)
from concurrent_step.Memop [OF i_bound' ts_i' memop_step] ts' i_bound
show ?thesis
by (auto simp add: ts' list_update_append)
next
case (StoreBuffer i p "is" θ sb 𝒟 𝒪 ℛ sb' 𝒪' ℛ')
then obtain
i_bound: "i < length ts" and
ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)" and
sb_step: "(m,sb,𝒪,ℛ,𝒮) →⇩s⇩b (m',sb',𝒪',ℛ',𝒮')" and
ts': "ts'=ts[i:=(p,is,θ,sb',𝒟,𝒪',ℛ')]"
by auto
from i_bound have i_bound': "i + length xs < length (xs@ts)"
by auto
from ts_i i_bound have ts_i': "(xs@ts)!(i + length xs) = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (auto simp add: nth_append)
from concurrent_step.StoreBuffer [OF i_bound' ts_i' sb_step] ts' i_bound
show ?thesis
by (auto simp add: ts' list_update_append)
qed
primrec weak_sharing_consistent:: "owns ⇒ 'a memref list ⇒ bool"
where
"weak_sharing_consistent 𝒪 [] = True"
| "weak_sharing_consistent 𝒪 (r#rs) =
(case r of
Write⇩s⇩b volatile _ _ _ A L R W ⇒
(if volatile then L ⊆ A ∧ A ∩ R = {} ∧ R ⊆ 𝒪 ∧
weak_sharing_consistent (𝒪 ∪ A - R) rs
else weak_sharing_consistent 𝒪 rs)
| Ghost⇩s⇩b A L R W ⇒ L ⊆ A ∧ A ∩ R = {} ∧ R ⊆ 𝒪 ∧ weak_sharing_consistent (𝒪 ∪ A - R) rs
| _ ⇒ weak_sharing_consistent 𝒪 rs)"
lemma sharing_consistent_weak_sharing_consistent:
"⋀𝒮 𝒪. sharing_consistent 𝒮 𝒪 sb ⟹ weak_sharing_consistent 𝒪 sb"
apply (induct sb)
apply (auto split: memref.splits)
done
lemma weak_sharing_consistent_append:
"⋀𝒪. weak_sharing_consistent 𝒪 (xs @ ys) =
(weak_sharing_consistent 𝒪 xs ∧ weak_sharing_consistent (acquired True xs 𝒪) ys)"
apply (induct xs)
apply (auto split: memref.splits)
done
lemma read_only_share_unowned: "⋀𝒪 𝒮.
⟦weak_sharing_consistent 𝒪 sb; a ∉ 𝒪 ∪ all_acquired sb; a ∈ read_only (share sb 𝒮)⟧
⟹ a ∈ read_only 𝒮"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b True in_read_only_restrict_conv in_read_only_augment_conv
split: if_split_asm)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and 𝒪="(𝒪 ∪ A - R)"] Cons.prems show ?thesis
by (auto simp add: in_read_only_restrict_conv in_read_only_augment_conv split: if_split_asm)
qed
qed
lemma share_read_only_mono_in:
assumes a_in: "a ∈ read_only (share sb 𝒮)"
assumes ss: "read_only 𝒮 ⊆ read_only 𝒮'"
shows "a ∈ read_only (share sb 𝒮')"
using share_read_only_mono [OF ss] a_in
by auto
lemma read_only_unacquired_share:
"⋀S 𝒪. ⟦𝒪 ∩ read_only S = {}; weak_sharing_consistent 𝒪 sb; a ∈ read_only S;
a ∉ all_acquired sb ⟧
⟹ a ∈ read_only (share sb S)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
obtain a_ro: "a ∈ read_only S" and a_A: "a ∉ A" and a_unacq: "a ∉ all_acquired sb" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_ro a_A owns_ro R_owns L_A have a_ro': "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro' a_unacq]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False
with Cons show ?thesis
by (clarsimp simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (clarsimp)
next
case Prog⇩s⇩b with Cons show ?thesis by (clarsimp)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
obtain a_ro: "a ∈ read_only S" and a_A: "a ∉ A" and a_unacq: "a ∉ all_acquired sb" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_ro a_A owns_ro R_owns L_A have a_ro': "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro' a_unacq]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma read_only_share_unacquired: "⋀ 𝒪 S. 𝒪 ∩ read_only S = {} ⟹ weak_sharing_consistent 𝒪 sb ⟹
a ∈ read_only (share sb S) ⟹ a ∉ acquired True sb 𝒪"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
note volatile=this
from Cons.prems
obtain a_ro: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b volatile)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro]
show ?thesis
by (auto simp add: Write⇩s⇩b volatile)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
obtain a_ro: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro]
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma read_only_share_all_acquired_in:
"⋀S 𝒪. ⟦𝒪 ∩ read_only S = {}; weak_sharing_consistent 𝒪 sb; a ∈ read_only (share sb S)⟧
⟹ a ∈ read_only (share sb Map.empty) ∨ (a ∈ read_only S ∧ a ∉ all_acquired sb)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
obtain a_in: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_in]
have hyp: "a ∈ read_only (share sb Map.empty) ∨ a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_acquired sb".
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∨ (a ∈ read_only S ∧ a ∉ A ∧ a ∉ all_acquired sb)"
proof -
{
assume a_emp: "a ∈ read_only (share sb Map.empty)"
have "read_only Map.empty ⊆ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from share_read_only_mono_in [OF a_emp this]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
}
moreover
{
assume a_ro: "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unacq: "a ∉ all_acquired sb"
have ?thesis
proof (cases "a ∈ read_only S")
case True
with a_ro obtain "a ∉ A"
by (auto simp add: in_read_only_convs)
with True a_unacq show ?thesis
by auto
next
case False
with a_ro have a_ro_empty: "a ∈ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
have "read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
with owns_ro'
have owns_ro_empty: "(𝒪 ∪ A - R) ∩ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by blast
from read_only_unacquired_share [OF owns_ro_empty consis' a_ro_empty a_unacq]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
thus ?thesis
by simp
qed
}
moreover note hyp
ultimately show ?thesis by blast
qed
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
obtain a_in: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_in]
have hyp: "a ∈ read_only (share sb Map.empty) ∨ a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ all_acquired sb".
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∨ (a ∈ read_only S ∧ a ∉ A ∧ a ∉ all_acquired sb)"
proof -
{
assume a_emp: "a ∈ read_only (share sb Map.empty)"
have "read_only Map.empty ⊆ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from share_read_only_mono_in [OF a_emp this]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
}
moreover
{
assume a_ro: "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unacq: "a ∉ all_acquired sb"
have ?thesis
proof (cases "a ∈ read_only S")
case True
with a_ro obtain "a ∉ A"
by (auto simp add: in_read_only_convs)
with True a_unacq show ?thesis
by auto
next
case False
with a_ro have a_ro_empty: "a ∈ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
have "read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
with owns_ro'
have owns_ro_empty: "(𝒪 ∪ A - R) ∩ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by blast
from read_only_unacquired_share [OF owns_ro_empty consis' a_ro_empty a_unacq]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
thus ?thesis
by simp
qed
}
moreover note hyp
ultimately show ?thesis by blast
qed
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma weak_sharing_consistent_preserves_distinct:
"⋀𝒪 𝒮. weak_sharing_consistent 𝒪 sb ⟹ 𝒪 ∩ read_only 𝒮 = {} ⟹
acquired True sb 𝒪 ∩ read_only (share sb 𝒮) = {}"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF consis' owns_ro']
show ?thesis
by (auto simp add: Write⇩s⇩b True)
next
case False with Cons Write⇩s⇩b show ?thesis by auto
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF consis' owns_ro']
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
locale weak_sharing_consis =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes weak_sharing_consis:
"⋀i p is 𝒪 ℛ 𝒟 θ sb.
⟦i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ) ⟧
⟹
weak_sharing_consistent 𝒪 sb"
sublocale sharing_consis ⊆ weak_sharing_consis
proof
fix i p "is" 𝒪 ℛ 𝒟 θ sb
assume i_bound: "i < length ts"
assume ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ)"
from sharing_consistent_weak_sharing_consistent [OF sharing_consis [OF i_bound ts_i]]
show "weak_sharing_consistent 𝒪 sb".
qed
lemma weak_sharing_consis_tl: "weak_sharing_consis (t#ts) ⟹ weak_sharing_consis ts"
apply (unfold weak_sharing_consis_def)
apply force
done
lemma read_only_share_all_until_volatile_write_unacquired:
"⋀𝒮. ⟦ownership_distinct ts; read_only_unowned 𝒮 ts; weak_sharing_consis ts;
∀i < length ts. (let (_,_,_,sb,_,𝒪,ℛ) = ts!i in
a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb));
a ∈ read_only 𝒮⟧
⟹ a ∈ read_only (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p "is" 𝒪 ℛ 𝒟 θ sb where
t: "t = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
have a_ro: "a ∈ read_only 𝒮" by fact
have ro_unowned: "read_only_unowned 𝒮 (t#ts)" by fact
then interpret read_only_unowned 𝒮 "t#ts" .
have consis: "weak_sharing_consis (t#ts)" by fact
then interpret weak_sharing_consis "t#ts" .
note consis' = weak_sharing_consis_tl [OF consis]
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from weak_sharing_consis [of 0] t
have consis_sb: "weak_sharing_consistent 𝒪 sb"
by force
with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
have ro_unowned': "read_only_unowned (share ?take_sb 𝒮) ts"
proof
fix j
fix p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts"
assume jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (share ?take_sb 𝒮) = {}"
proof -
{
fix a
assume a_owns: "a ∈ 𝒪⇩j"
assume a_ro: "a ∈ read_only (share ?take_sb 𝒮)"
have False
proof -
from ownership_distinct [of 0 "Suc j"] j_bound jth t
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by fastforce
from read_only_unowned [of "Suc j"] j_bound jth
have dist_ro: "𝒪⇩j ∩ read_only 𝒮 = {}" by force
show ?thesis
proof (cases "a ∈ (𝒪 ∪ all_acquired sb)")
case True
with dist a_owns show False by auto
next
case False
hence "a ∉ (𝒪 ∪ all_acquired ?take_sb)"
using all_acquired_append [of ?take_sb ?drop_sb]
by auto
from read_only_share_unowned [OF consis_take this a_ro]
have "a ∈ read_only 𝒮".
with dist_ro a_owns show False by auto
qed
qed
}
thus ?thesis by auto
qed
qed
from Cons.prems
obtain unacq_ts: "∀i < length ts. (let (_,_,_,sb,_,𝒪,_) = ts!i in
a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb))" and
unacq_sb: "a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (force simp add: t aargh)
from read_only_unowned [of 0] t
have owns_ro: "𝒪 ∩ read_only 𝒮 = {}"
by force
from read_only_unacquired_share [OF owns_ro consis_take a_ro unacq_sb]
have "a ∈ read_only (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)".
from Cons.hyps [OF dist' ro_unowned' consis' unacq_ts this]
show ?case
by (simp add: t)
qed
lemma read_only_share_unowned_in:
"⟦weak_sharing_consistent 𝒪 sb; a ∈ read_only (share sb 𝒮)⟧
⟹ a ∈ read_only 𝒮 ∪ 𝒪 ∪ all_acquired sb"
using read_only_share_unowned [of 𝒪 sb]
by auto
lemma read_only_shared_all_until_volatile_write_subset:
"⋀𝒮. ⟦ownership_distinct ts;
weak_sharing_consis ts⟧ ⟹
read_only (share_all_until_volatile_write ts 𝒮) ⊆
read_only 𝒮 ∪ (⋃((λ(_, _, _, sb, _, 𝒪,_). 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p "is" 𝒪 ℛ 𝒟 θ sb where
t: "t = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
have consis: "weak_sharing_consis (t#ts)" by fact
then interpret weak_sharing_consis "t#ts" .
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
note consis' = weak_sharing_consis_tl [OF consis]
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from weak_sharing_consis [of 0] t
have consis_sb: "weak_sharing_consistent 𝒪 sb"
by force
with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
{
fix a
assume a_in: "a ∈ read_only
(share_all_until_volatile_write ts
(share ?take_sb 𝒮))" and
a_notin_shared: "a ∉ read_only 𝒮" and
a_notin_rest: "a ∉ (⋃((λ(_, _, _, sb, _, 𝒪,_). 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
have "a ∈ 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
proof -
from Cons.hyps [OF dist' consis', of "(share ?take_sb 𝒮)"] a_in a_notin_rest
have "a ∈ read_only (share ?take_sb 𝒮)"
by (auto simp add: aargh)
from read_only_share_unowned_in [OF consis_take this] a_notin_shared
show ?thesis by auto
qed
}
then show ?case
by (auto simp add: t aargh)
qed
lemma weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write:
"⋀𝒮 i. ⟦ownership_distinct ts; read_only_unowned 𝒮 ts;weak_sharing_consis ts;
i < length ts; ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)⟧
⟹ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∩
read_only (share_all_until_volatile_write ts 𝒮) = {}"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
note ‹read_only_unowned 𝒮 (t#ts)›
then interpret read_only_unowned 𝒮 "t#ts" .
note i_bound = ‹i < length (t # ts)›
note ith = ‹(t # ts) ! i = (p,is,θ, sb, 𝒟, 𝒪,ℛ)›
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
have consis: "weak_sharing_consis (t#ts)" by fact
then interpret weak_sharing_consis "t#ts" .
note consis' = weak_sharing_consis_tl [OF consis]
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases i)
case 0
from read_only_unowned [of 0] ith 0
have owns_ro: "𝒪 ∩ read_only 𝒮 = {}"
by force
from weak_sharing_consis [of 0] ith 0
have "weak_sharing_consistent 𝒪 sb"
by force
with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
from weak_sharing_consistent_preserves_distinct [OF this owns_ro]
have dist_t: "acquired True ?take_sb 𝒪 ∩ read_only (share ?take_sb 𝒮) = {}".
from read_only_shared_all_until_volatile_write_subset [OF dist' consis', of "(share ?take_sb 𝒮)"]
have ro_rest: "read_only (share_all_until_volatile_write ts (share ?take_sb 𝒮)) ⊆
read_only (share ?take_sb 𝒮) ∪
(⋃((λ(_, _, _, sb, _, 𝒪,_). 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
by auto
{
fix a
assume a_in_sb: "a ∈ acquired True ?take_sb 𝒪"
assume a_in_ro: "a ∈ read_only (share_all_until_volatile_write ts (share ?take_sb 𝒮))"
have False
proof -
from Set.in_mono [rule_format, OF ro_rest a_in_ro] dist_t a_in_sb
have "a ∈ (⋃((λ(_, _, _, sb, _, 𝒪,_). 𝒪 ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
by auto
then obtain j p⇩j "is⇩j" θ⇩j sb⇩j 𝒟⇩j 𝒪⇩j ℛ⇩j
where j_bound: "j < length ts" and ts_j: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
and a_in_j: "a ∈ 𝒪⇩j ∪ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by (fastforce simp add: in_set_conv_nth)
from ownership_distinct [of 0 "Suc j"] ith ts_j j_bound 0
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by fastforce
moreover
from acquired_all_acquired [of True ?take_sb 𝒪] a_in_sb all_acquired_append [of ?take_sb ?drop_sb]
have "a ∈ 𝒪 ∪ all_acquired sb"
by auto
with a_in_j all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
dist
have False by fastforce
thus ?thesis ..
qed
}
then show ?thesis
using 0 ith
by (auto simp add: aargh)
next
case (Suc k)
from i_bound Suc have k_bound: "k < length ts"
by auto
from ith Suc have kth: "ts!k = (p, is, θ, sb, 𝒟, 𝒪, ℛ)"
by auto
obtain p⇩t "is⇩t" 𝒪⇩t ℛ⇩t 𝒟⇩t θ⇩t sb⇩t
where t: "t=(p⇩t,is⇩t,θ⇩t,sb⇩t,𝒟⇩t,𝒪⇩t,ℛ⇩t)"
by (cases t)
let ?take_sb⇩t = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
let ?drop_sb⇩t = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩t)"
have ro_unowned': "read_only_unowned (share ?take_sb⇩t 𝒮) ts"
proof
fix j
fix p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts"
assume jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (share ?take_sb⇩t 𝒮) = {}"
proof -
from read_only_unowned [of "Suc j"] j_bound jth
have dist: "𝒪⇩j ∩ read_only 𝒮 = {}" by force
from weak_sharing_consis [of 0] t
have "weak_sharing_consistent 𝒪⇩t sb⇩t"
by fastforce
with weak_sharing_consistent_append [of 𝒪⇩t ?take_sb⇩t ?drop_sb⇩t]
have consis_t: "weak_sharing_consistent 𝒪⇩t ?take_sb⇩t"
by auto
{
fix a
assume a_in_j: "a ∈ 𝒪⇩j"
assume a_ro: "a ∈ read_only (share ?take_sb⇩t 𝒮)"
have False
proof -
from a_in_j ownership_distinct [of 0 "Suc j"] j_bound t jth
have "(𝒪⇩t ∪ all_acquired sb⇩t) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by fastforce
with a_in_j all_acquired_append [of ?take_sb⇩t ?drop_sb⇩t]
have "a ∉ (𝒪⇩t ∪ all_acquired ?take_sb⇩t)"
by fastforce
from read_only_share_unowned [OF consis_t this a_ro]
have "a ∈ read_only 𝒮" .
with a_in_j dist
show False by auto
qed
}
then
show ?thesis
by auto
qed
qed
from Cons.hyps [OF dist' ro_unowned' consis' k_bound kth]
show ?thesis
by (simp add: t)
qed
qed
lemma in_read_only_share_all_until_volatile_write:
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes ro_unowned: "read_only_unowned 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_unacquired_others: "∀j < length ts. i≠j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts!j in
a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
assumes a_ro_share: "a ∈ read_only (share sb 𝒮)"
shows "a ∈ read_only (share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
(share_all_until_volatile_write ts 𝒮))"
proof -
from consis
interpret sharing_consis 𝒮 ts .
interpret read_only_unowned 𝒮 ts by fact
from sharing_consis [OF i_bound ts_i]
have consis_sb: "sharing_consistent 𝒮 𝒪 sb".
from sharing_consistent_weak_sharing_consistent [OF this]
have weak_consis: "weak_sharing_consistent 𝒪 sb".
from read_only_unowned [OF i_bound ts_i]
have owns_ro: "𝒪 ∩ read_only 𝒮 = {}".
from read_only_share_all_acquired_in [OF owns_ro weak_consis a_ro_share]
have "a ∈ read_only (share sb Map.empty) ∨ a ∈ read_only 𝒮 ∧ a ∉ all_acquired sb".
moreover
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
obtain weak_consis': "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb" and
weak_consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
{
assume "a ∈ read_only (share sb Map.empty)"
with share_append [of ?take_sb ?drop_sb]
have a_in': "a ∈ read_only (share ?drop_sb (share ?take_sb Map.empty))"
by auto
have owns_empty: "𝒪 ∩ read_only Map.empty = {}"
by auto
from weak_sharing_consistent_preserves_distinct [OF weak_consis_take owns_empty]
have "acquired True ?take_sb 𝒪 ∩ read_only (share ?take_sb Map.empty) = {}".
from read_only_share_all_acquired_in [OF this weak_consis' a_in']
have "a ∈ read_only (share ?drop_sb Map.empty) ∨ a ∈ read_only (share ?take_sb Map.empty) ∧ a ∉ all_acquired ?drop_sb".
moreover
{
assume a_ro_drop: "a ∈ read_only (share ?drop_sb Map.empty)"
have "read_only Map.empty ⊆ read_only (share_all_until_volatile_write ts 𝒮)"
by auto
from share_read_only_mono_in [OF a_ro_drop this]
have ?thesis .
}
moreover
{
assume a_ro_take: "a ∈ read_only (share ?take_sb Map.empty)"
assume a_unacq_drop: "a ∉ all_acquired ?drop_sb"
from read_only_share_unowned_in [OF weak_consis_take a_ro_take]
have "a ∈ 𝒪 ∪ all_acquired ?take_sb" by auto
hence "a ∈ 𝒪 ∪ all_acquired sb" using all_acquired_append [of ?take_sb ?drop_sb]
by auto
from share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i this] a_ro_share
have ?thesis by (auto simp add: read_only_def)
}
ultimately have ?thesis by blast
}
moreover
{
assume a_ro: "a ∈ read_only 𝒮"
assume a_unacq: "a ∉ all_acquired sb"
with all_acquired_append [of ?take_sb ?drop_sb]
obtain "a ∉ all_acquired ?take_sb" and a_notin_drop: "a ∉ all_acquired ?drop_sb"
by auto
with a_unacquired_others i_bound ts_i
have a_unacq: "∀j < length ts.
(let (_,_,_,sb⇩j,_,_,_) = ts!j in
a ∉ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
by (auto simp add: Let_def)
from local.weak_sharing_consis_axioms have "weak_sharing_consis ts" .
from read_only_share_all_until_volatile_write_unacquired [OF dist ro_unowned
‹weak_sharing_consis ts› a_unacq a_ro]
have a_ro_all: "a ∈ read_only (share_all_until_volatile_write ts 𝒮)" .
from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have weak_consis_drop: "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb"
by auto
from weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write [OF dist
ro_unowned ‹weak_sharing_consis ts› i_bound ts_i]
have "acquired True ?take_sb 𝒪 ∩
read_only (share_all_until_volatile_write ts 𝒮) = {}".
from read_only_unacquired_share [OF this weak_consis_drop a_ro_all a_notin_drop]
have ?thesis .
}
ultimately show ?thesis by blast
qed
lemma all_acquired_dropWhile_in: "x ∈ all_acquired (dropWhile P sb) ⟹ x ∈ all_acquired sb"
using all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
by auto
lemma all_acquired_takeWhile_in: "x ∈ all_acquired (takeWhile P sb) ⟹ x ∈ all_acquired sb"
using all_acquired_append [of "takeWhile P sb" "dropWhile P sb"]
by auto
lemmas all_acquired_takeWhile_dropWhile_in = all_acquired_takeWhile_in all_acquired_dropWhile_in
lemma split_in_read_only_reads:
"⋀𝒪. a ∈ read_only_reads 𝒪 xs ⟹
(∃t v ys zs. xs=ys @ Read⇩s⇩b False a t v # zs ∧ a ∉ acquired True ys 𝒪)"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
have a_in: "a ∈ read_only_reads 𝒪 (x#xs)" by fact
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
from a_in have "a ∈ read_only_reads 𝒪 xs"
by (auto simp add: Write⇩s⇩b False)
from Cons.hyps [OF this] obtain t v ys zs where
xs: "xs=ys@Read⇩s⇩b False a t v # zs" and a_notin: "a ∉ acquired True ys 𝒪"
by auto
with xs a_notin obtain "x#xs=(x#ys)@Read⇩s⇩b False a t v # zs" "a ∉ acquired True (x#ys) 𝒪"
by (simp add: Write⇩s⇩b False)
then show ?thesis
by blast
next
case True
from a_in have "a ∈ read_only_reads (𝒪 ∪ A - R) xs"
by (auto simp add: Write⇩s⇩b True)
from Cons.hyps [OF this] obtain t v ys zs where
xs: "xs=ys@Read⇩s⇩b False a t v # zs" and a_notin: "a ∉ acquired True ys (𝒪 ∪ A - R)"
by auto
with xs a_notin obtain "x#xs=(x#ys)@Read⇩s⇩b False a t v # zs" "a ∉ acquired True (x#ys) 𝒪"
by (simp add: Write⇩s⇩b True)
then show ?thesis
by blast
qed
next
case (Read⇩s⇩b volatile a' t' v')
show ?thesis
proof (cases "¬ volatile ∧ a ∉ 𝒪 ∧ a'=a")
case True
with Read⇩s⇩b show ?thesis
by fastforce
next
case False
with a_in have "a ∈ read_only_reads 𝒪 xs"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF this] obtain t v ys zs where
xs: "xs=ys@Read⇩s⇩b False a t v # zs" and a_notin: "a ∉ acquired True ys 𝒪"
by auto
with xs a_notin obtain "x#xs=(x#ys)@Read⇩s⇩b False a t v # zs" "a ∉ acquired True (x#ys) 𝒪"
by (simp add: Read⇩s⇩b)
then show ?thesis
by blast
qed
next
case Prog⇩s⇩b
with a_in have "a ∈ read_only_reads 𝒪 xs"
by (auto)
from Cons.hyps [OF this] obtain t v ys zs where
xs: "xs=ys@Read⇩s⇩b False a t v # zs" and a_notin: "a ∉ acquired True ys 𝒪"
by auto
with xs a_notin obtain "x#xs=(x#ys)@Read⇩s⇩b False a t v # zs" "a ∉ acquired True (x#ys) 𝒪"
by (simp add: Prog⇩s⇩b)
then show ?thesis
by blast
next
case (Ghost⇩s⇩b A L R W)
with a_in have "a ∈ read_only_reads (𝒪 ∪ A - R) xs"
by (auto)
from Cons.hyps [OF this] obtain t v ys zs where
xs: "xs=ys@Read⇩s⇩b False a t v # zs" and a_notin: "a ∉ acquired True ys (𝒪 ∪ A -R)"
by auto
with xs a_notin obtain "x#xs=(x#ys)@Read⇩s⇩b False a t v # zs" "a ∉ acquired True (x#ys) 𝒪"
by (simp add: Ghost⇩s⇩b)
then show ?thesis
by blast
qed
qed
lemma insert_monoD: "W ⊆ W' ⟹ insert a W ⊆ insert a W'"
by blast
primrec unforwarded_non_volatile_reads:: "'a memref list ⇒ addr set ⇒ addr set"
where
"unforwarded_non_volatile_reads [] W = {}"
| "unforwarded_non_volatile_reads (x#xs) W =
(case x of
Read⇩s⇩b volatile a _ _ ⇒ (if a ∉ W ∧ ¬ volatile
then insert a (unforwarded_non_volatile_reads xs W)
else (unforwarded_non_volatile_reads xs W))
| Write⇩s⇩b _ a _ _ _ _ _ _ ⇒ unforwarded_non_volatile_reads xs (insert a W)
| _ ⇒ unforwarded_non_volatile_reads xs W)"
lemma unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b:
"⋀W. unforwarded_non_volatile_reads sb W ⊆ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
apply (induct sb)
apply (auto split: memref.splits if_split_asm)
done
lemma in_unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b:
"a ∈ unforwarded_non_volatile_reads sb W ⟹ a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
using unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b
by blast
lemma unforwarded_non_volatile_reads_antimono:
"⋀W W'. W ⊆ W' ⟹ unforwarded_non_volatile_reads xs W' ⊆ unforwarded_non_volatile_reads xs W"
apply (induct xs)
apply (auto split: memref.splits dest: insert_monoD)
done
lemma unforwarded_non_volatile_reads_antimono_in:
"x ∈ unforwarded_non_volatile_reads xs W' ⟹ W ⊆ W'
⟹ x ∈ unforwarded_non_volatile_reads xs W"
using unforwarded_non_volatile_reads_antimono
by blast
lemma unforwarded_non_volatile_reads_append: "⋀W. unforwarded_non_volatile_reads (xs@ys) W =
(unforwarded_non_volatile_reads xs W ∪
unforwarded_non_volatile_reads ys (W ∪ outstanding_refs is_Write⇩s⇩b xs))"
apply (induct xs)
apply clarsimp
apply (auto split: memref.splits)
done
lemma reads_consistent_mem_eq_on_unforwarded_non_volatile_reads:
assumes mem_eq: "∀a ∈ A ∪ W. m' a = m a"
assumes subset: "unforwarded_non_volatile_reads sb W ⊆ A"
assumes consis_m: "reads_consistent pending_write 𝒪 m sb"
shows "reads_consistent pending_write 𝒪 m' sb"
using mem_eq subset consis_m
proof (induct sb arbitrary: A W m' m pending_write 𝒪)
case Nil thus ?case by simp
next
case (Cons r sb)
note mem_eq = ‹∀a ∈ A ∪ W. m' a = m a›
note subset = ‹unforwarded_non_volatile_reads (r#sb) W ⊆ A›
note consis_m = ‹reads_consistent pending_write 𝒪 m (r#sb)›
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a sop v A' L R W')
from subset obtain
subset': "unforwarded_non_volatile_reads sb (insert a W) ⊆ A"
by (auto simp add: Write⇩s⇩b)
from mem_eq
have mem_eq':
"∀a' ∈ (A ∪ (insert a W)). (m'(a:=v)) a' = (m(a:=v)) a'"
by (auto)
show ?thesis
proof (cases volatile)
case True
from consis_m obtain
consis': "reads_consistent True (𝒪 ∪ A' - R) (m(a := v)) sb" and
no_volatile_Read⇩s⇩b: "outstanding_refs is_volatile_Read⇩s⇩b sb = {}"
by (simp add: Write⇩s⇩b True)
from Cons.hyps [OF mem_eq' subset' consis']
have "reads_consistent True (𝒪 ∪ A' - R) (m'(a := v)) sb".
with no_volatile_Read⇩s⇩b
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False
from consis_m obtain consis': "reads_consistent pending_write 𝒪 (m(a := v)) sb"
by (simp add: Write⇩s⇩b False)
from Cons.hyps [OF mem_eq' subset' consis']
have "reads_consistent pending_write 𝒪 (m'(a := v)) sb".
then
show ?thesis
by (simp add: Write⇩s⇩b False)
qed
next
case (Read⇩s⇩b volatile a t v)
from mem_eq
have mem_eq':
"∀a' ∈ A ∪ W. m' a' = m a'"
by (auto)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from consis_m obtain
consis': "reads_consistent pending_write 𝒪 m sb"
by (simp add: Read⇩s⇩b True)
show ?thesis
proof (cases "a ∈ W")
case False
from subset obtain
subset': "unforwarded_non_volatile_reads sb W ⊆ A"
using False
by (auto simp add: Read⇩s⇩b True split: if_split_asm)
from Cons.hyps [OF mem_eq' subset' consis']
show ?thesis
by (simp add: Read⇩s⇩b True)
next
case True
from subset have
subset': "unforwarded_non_volatile_reads sb W ⊆
insert a A "
using True
apply (auto simp add: Read⇩s⇩b volatile split: if_split_asm)
done
from mem_eq True have mem_eq': "∀a' ∈ (insert a A) ∪ W. m' a' = m a'"
by auto
from Cons.hyps [OF mem_eq' subset' consis']
show ?thesis
by (simp add: Read⇩s⇩b volatile)
qed
next
case False
note non_vol = this
from consis_m obtain
consis': "reads_consistent pending_write 𝒪 m sb" and
v: "(pending_write ∨ a ∈ 𝒪) ⟶ v=m a"
by (simp add: Read⇩s⇩b False)
show ?thesis
proof (cases "a ∈ W")
case True
from mem_eq subset Read⇩s⇩b True non_vol have "m' a = m a"
by (auto simp add: False)
from subset obtain
subset': "unforwarded_non_volatile_reads sb W ⊆ insert a A"
using False
by (auto simp add: Read⇩s⇩b non_vol split: if_split_asm)
from mem_eq True have mem_eq': "∀a' ∈ (insert a A) ∪ W. m' a' = m a'"
by auto
with Cons.hyps [OF mem_eq' subset' consis'] v
show ?thesis
by (simp add: Read⇩s⇩b non_vol)
next
case False
from mem_eq subset Read⇩s⇩b False non_vol have meq: "m' a = m a"
by (clarsimp )
from subset obtain
subset': "unforwarded_non_volatile_reads sb W ⊆ A"
using non_vol False
by (auto simp add: Read⇩s⇩b non_vol split: if_split_asm)
from mem_eq non_vol have mem_eq': "∀a' ∈ A ∪ W. m' a' = m a'"
by auto
with Cons.hyps [OF mem_eq' subset' consis'] v meq
show ?thesis
by (simp add: Read⇩s⇩b non_vol False)
qed
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case Ghost⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop:
assumes mem_eq: "∀a ∈ A ∪ W. m' a = m a"
assumes subset: "unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) W ⊆ A"
assumes subset_acq: "acquired_reads True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ⊆ A"
assumes consis_m: "reads_consistent False 𝒪 m sb"
shows "reads_consistent False 𝒪 m' sb"
using mem_eq subset subset_acq consis_m
proof (induct sb arbitrary: A W m' m 𝒪)
case Nil thus ?case by simp
next
case (Cons r sb)
note mem_eq = ‹∀a ∈ A ∪ W. m' a = m a›
note subset = ‹unforwarded_non_volatile_reads
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (r#sb)) W ⊆ A›
note subset_acq = ‹acquired_reads True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b)(r#sb)) 𝒪 ⊆ A›
note consis_m = ‹reads_consistent False 𝒪 m (r#sb)›
show ?case
proof (cases r)
case (Write⇩s⇩b volatile a sop v A' L R W')
show ?thesis
proof (cases volatile)
case True
from mem_eq
have mem_eq':
"∀a' ∈ (A ∪ (insert a W)). (m'(a:=v)) a' = (m(a:=v)) a'"
by (auto)
from consis_m obtain
consis': "reads_consistent True (𝒪 ∪ A' - R) (m(a := v)) sb" and
no_volatile_Read⇩s⇩b: "outstanding_refs is_volatile_Read⇩s⇩b sb = {}"
by (simp add: Write⇩s⇩b True)
from subset obtain "unforwarded_non_volatile_reads sb (insert a W) ⊆ A"
by (clarsimp simp add: Write⇩s⇩b True)
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [OF mem_eq' this consis']
have "reads_consistent True (𝒪 ∪ A' - R) (m'(a := v)) sb".
with no_volatile_Read⇩s⇩b
show ?thesis
by (simp add: Write⇩s⇩b True)
next
case False
from mem_eq
have mem_eq':
"∀a' ∈ (A ∪ W). (m'(a:=v)) a' = (m(a:=v)) a'"
by (auto)
from subset obtain
subset': "unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) W ⊆ A"
by (auto simp add: Write⇩s⇩b False)
from subset_acq have
subset_acq': "acquired_reads True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ⊆ A"
by (auto simp add: Write⇩s⇩b False)
from consis_m obtain consis': "reads_consistent False 𝒪 (m(a := v)) sb"
by (simp add: Write⇩s⇩b False)
from Cons.hyps [OF mem_eq' subset' subset_acq' consis']
have "reads_consistent False 𝒪 (m'(a := v)) sb".
then
show ?thesis
by (simp add: Write⇩s⇩b False)
qed
next
case (Read⇩s⇩b volatile a t v)
from mem_eq
have mem_eq':
"∀a' ∈ A ∪ W. m' a' = m a'"
by (auto)
from subset obtain
subset': "unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) W ⊆ A"
by (clarsimp simp add: Read⇩s⇩b)
from subset_acq obtain
a_A: "¬ volatile ⟶ a ∈ 𝒪 ⟶ a ∈ A" and
subset_acq': "acquired_reads True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ⊆ A"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from consis_m obtain
consis': "reads_consistent False 𝒪 m sb"
by (simp add: Read⇩s⇩b True)
from Cons.hyps [OF mem_eq' subset' subset_acq' consis']
show ?thesis
by (simp add: Read⇩s⇩b True)
next
case False
note non_vol = this
from consis_m obtain
consis': "reads_consistent False 𝒪 m sb" and
v: "a ∈ 𝒪 ⟶ v=m a"
by (simp add: Read⇩s⇩b False)
from mem_eq a_A v have v': "a ∈ 𝒪 ⟶ v=m' a"
by (auto simp add: non_vol)
from Cons.hyps [OF mem_eq' subset' subset_acq' consis'] v'
show ?thesis
by (simp add: Read⇩s⇩b False)
qed
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case Ghost⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma read_only_read_witness:"⋀𝒮 𝒪.
⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
a ∈ read_only_reads 𝒪 sb⟧
⟹
∃xs ys t v. sb=xs@ Read⇩s⇩b False a t v # ys ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
a_ro: "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from Cons.hyps [OF nvo' a_ro]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧ a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∧
a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Write⇩s⇩b True)
done
next
case False
from Cons.prems obtain
a_ro: "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (clarsimp simp add: Write⇩s⇩b False)
from Cons.hyps [OF nvo' a_ro]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Write⇩s⇩b False)
done
qed
next
case (Read⇩s⇩b volatile a' t v)
show ?thesis
proof (cases "a'=a ∧ a ∉ 𝒪 ∧ ¬ volatile")
case True
with Cons.prems have "a ∈ read_only 𝒮"
by (simp add: Read⇩s⇩b)
with True show ?thesis
apply -
apply (rule_tac x="[]" in exI)
apply (rule_tac x="sb" in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Read⇩s⇩b)
done
next
case False
with Cons.prems obtain
a_ro: "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF nvo' a_ro]
obtain xs ys t' v' where
"sb = xs @ Read⇩s⇩b False a t' v' # ys ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
with False show ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t' in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Read⇩s⇩b )
done
qed
next
case Prog⇩s⇩b
from Cons.prems obtain
a_ro: "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (clarsimp simp add: Prog⇩s⇩b)
from Cons.hyps [OF nvo' a_ro]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Prog⇩s⇩b)
done
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_ro: "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from Cons.hyps [OF nvo' a_ro]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧ a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∧ a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
qed
qed
lemma read_only_read_acquired_witness: "⋀𝒮 𝒪.
⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
a ∉ read_only 𝒮; a ∉ 𝒪; a ∈ read_only_reads 𝒪 sb⟧
⟹
∃xs ys t v. sb=xs@ Read⇩s⇩b False a t v # ys ∧ a ∈ all_acquired xs ∧ a ∈ read_only (share xs 𝒮) ∧
a ∉ read_only_reads 𝒪 xs"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from R_owns a_unowned
have a_R: "a ∉ R"
by auto
show ?thesis
proof (cases "a ∈ A")
case True
from read_only_read_witness [OF nvo' a_ro']
obtain xs ys t v' where
sb: "sb = xs @ Read⇩s⇩b False a t v' # ys" and
ro: "a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
a_ro_xs: "a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
with True show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b volatile)
done
next
case False
with a_unowned R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro']
obtain xs ys t v' where "sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∧
a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
then show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b volatile)
done
qed
next
case False
from Cons.prems obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
"a' ∈ 𝒪" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (clarsimp simp add: Write⇩s⇩b False)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
obtain xs ys t v' where
"sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
then show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b False)
done
qed
next
case (Read⇩s⇩b volatile a' t v)
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
obtain xs ys t v' where
"sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
with Cons.prems show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Read⇩s⇩b)
done
next
case Prog⇩s⇩b
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro']
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∈ all_acquired xs ∧ a ∈ read_only (share xs 𝒮) ∧ a ∉ read_only_reads 𝒪 xs"
by blast
then show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Prog⇩s⇩b)
done
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from R_owns a_unowned
have a_R: "a ∉ R"
by auto
show ?thesis
proof (cases "a ∈ A")
case True
from read_only_read_witness [OF nvo' a_ro']
obtain xs ys t v' where
sb: "sb = xs @ Read⇩s⇩b False a t v' # ys" and
ro: "a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
a_ro_xs: "a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
with True show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
next
case False
with a_unowned R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro']
obtain xs ys t v' where "sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∈ read_only (share xs (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∧
a ∉ read_only_reads (𝒪 ∪ A - R) xs"
by blast
then show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
qed
qed
qed
lemma unforwarded_not_written: "⋀W. a ∈ unforwarded_non_volatile_reads sb W ⟹ a ∉ W"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W')
from Cons.prems
have "a ∈ unforwarded_non_volatile_reads sb (insert a' W)"
by (clarsimp simp add: Write⇩s⇩b )
from Cons.hyps [OF this]
have "a ∉ insert a' W".
then show ?thesis
by blast
next
case (Read⇩s⇩b volatile a' t v)
with Cons.hyps [of W] Cons.prems show ?thesis
by (auto split: if_split_asm)
next
case Prog⇩s⇩b
with Cons.hyps [of W] Cons.prems show ?thesis
by (auto split: if_split_asm)
next
case Ghost⇩s⇩b
with Cons.hyps [of W] Cons.prems show ?thesis
by (auto split: if_split_asm)
qed
qed
lemma unforwarded_witness:"⋀X.
⟦a ∈ unforwarded_non_volatile_reads sb X⟧
⟹
∃xs ys t v. sb=xs@ Read⇩s⇩b False a t v # ys ∧ a ∉ outstanding_refs is_Write⇩s⇩b xs"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
a_unforw: "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (clarsimp simp add: Write⇩s⇩b True)
from unforwarded_not_written [OF a_unforw]
have a'_a: "a'≠a"
by auto
from Cons.hyps [OF a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
thus ?thesis
using a'_a
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Write⇩s⇩b True)
done
next
case False
from Cons.prems obtain
a_unforw: "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (clarsimp simp add: Write⇩s⇩b False)
from unforwarded_not_written [OF a_unforw]
have a'_a: "a'≠a"
by auto
from Cons.hyps [OF a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
thus ?thesis
using a'_a
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Write⇩s⇩b False)
done
qed
next
case (Read⇩s⇩b volatile a' t v)
show ?thesis
proof (cases "a'=a ∧ a ∉ X ∧ ¬ volatile")
case True
with True show ?thesis
apply -
apply (rule_tac x="[]" in exI)
apply (rule_tac x="sb" in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Read⇩s⇩b)
done
next
case False
note not_ror = this
with Cons.prems obtain a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Read⇩s⇩b)
done
qed
next
case Prog⇩s⇩b
from Cons.prems obtain a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Prog⇩s⇩b)
done
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Ghost⇩s⇩b)
from Cons.hyps [OF a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
thus ?thesis
apply -
apply (rule_tac x="(x#xs)" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
qed
qed
lemma read_only_read_acquired_unforwarded_witness: "⋀𝒮 𝒪 X.
⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb; sharing_consistent 𝒮 𝒪 sb;
a ∉ read_only 𝒮; a ∉ 𝒪; a ∈ read_only_reads 𝒪 sb;
a ∈ unforwarded_non_volatile_reads sb X ⟧
⟹
∃xs ys t v. sb=xs@ Read⇩s⇩b False a t v # ys ∧ a ∈ all_acquired xs ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (clarsimp simp add: Write⇩s⇩b True)
from unforwarded_not_written [OF a_unforw]
have a_notin: "a ∉ insert a' X".
from R_owns a_unowned
have a_R: "a ∉ R"
by auto
show ?thesis
proof (cases "a ∈ A")
case True
from unforwarded_witness [OF a_unforw]
obtain xs ys t v' where
sb: "sb = xs @ Read⇩s⇩b False a t v' # ys" and
a_xs: "a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with True a_notin show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b volatile)
done
next
case False
with a_unowned R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro' a_unforw]
obtain xs ys t v' where "sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with a_notin show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b volatile)
done
qed
next
case False
from Cons.prems obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
"a' ∈ 𝒪" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw': "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (auto simp add: Write⇩s⇩b False split: if_split_asm)
from unforwarded_not_written [OF a_unforw']
have a_notin: "a ∉ insert a' X".
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw']
obtain xs ys t v' where
"sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with a_notin show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Write⇩s⇩b False)
done
qed
next
case (Read⇩s⇩b volatile a' t v)
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw]
obtain xs ys t v' where
"sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧ a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with Cons.prems show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Read⇩s⇩b)
done
next
case Prog⇩s⇩b
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads 𝒪 sb" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_ro' a_unforw]
obtain xs ys t v where
"sb = xs @ Read⇩s⇩b False a t v # ys ∧
a ∈ all_acquired xs ∧ a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
then show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v in exI)
apply (clarsimp simp add: Prog⇩s⇩b)
done
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a ∈ read_only_reads (𝒪 ∪ A - R) sb" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb (X)"
by (clarsimp simp add: Ghost⇩s⇩b)
from unforwarded_not_written [OF a_unforw]
have a_notin: "a ∉ X".
from R_owns a_unowned
have a_R: "a ∉ R"
by auto
show ?thesis
proof (cases "a ∈ A")
case True
from unforwarded_witness [OF a_unforw]
obtain xs ys t v' where
sb: "sb = xs @ Read⇩s⇩b False a t v' # ys" and
a_xs: "a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with True a_notin show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
next
case False
with a_unowned R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_ro' a_unforw]
obtain xs ys t v' where "sb = xs @ Read⇩s⇩b False a t v' # ys ∧
a ∈ all_acquired xs ∧
a ∉ outstanding_refs is_Write⇩s⇩b xs"
by blast
with a_notin show ?thesis
apply -
apply (rule_tac x="x#xs" in exI)
apply (rule_tac x=ys in exI)
apply (rule_tac x=t in exI)
apply (rule_tac x=v' in exI)
apply (clarsimp simp add: Ghost⇩s⇩b)
done
qed
qed
qed
lemma takeWhile_prefix: "∃ys. takeWhile P xs @ ys = xs"
apply (induct xs)
apply auto
done
lemma unforwarded_empty_extend:
"⋀W. x ∈ unforwarded_non_volatile_reads sb {} ⟹ x ∉ W ⟹ x ∈ unforwarded_non_volatile_reads sb W"
apply (induct sb)
apply clarsimp
subgoal for a sb W
apply (case_tac a)
apply clarsimp
apply (frule unforwarded_not_written)
apply (drule_tac W="{}" in unforwarded_non_volatile_reads_antimono_in)
apply blast
apply (auto split: if_split_asm)
done
done
lemma notin_unforwarded_empty:
"⋀W. a ∉ unforwarded_non_volatile_reads sb W ⟹ a ∉ W ⟹ a ∉ unforwarded_non_volatile_reads sb {}"
using unforwarded_empty_extend
by blast
lemma
assumes ro: "a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'"
assumes a_in: "a ∈ read_only (𝒮 ⊕⇘W⇙ R) "
shows "a ∈ read_only (𝒮' ⊕⇘W⇙ R) "
using ro a_in
by (auto simp add: in_read_only_convs)
lemma
assumes ro: "a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'"
assumes a_in: "a ∈ read_only (𝒮 ⊖⇘A⇙ L) "
shows "a ∈ read_only (𝒮' ⊖⇘A⇙ L) "
using ro a_in
by (auto simp add: in_read_only_convs)
lemma non_volatile_owned_or_read_only_read_only_reads_eq:
"⋀𝒮 𝒮' 𝒪 pending_write.
⟦non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
∀a ∈ read_only_reads 𝒪 sb. a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'
⟧
⟹ non_volatile_owned_or_read_only pending_write 𝒮' 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
ro': "∀a∈read_only_reads (𝒪 ∪ A - R) sb. a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'"
by (clarsimp simp add: Write⇩s⇩b volatile)
from ro'
have ro'':"∀a∈read_only_reads (𝒪 ∪ A - R) sb.
a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF nvo' ro'']
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case (Read⇩s⇩b volatile a t v)
show ?thesis
proof (cases volatile)
case True
with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case False
note non_vol = this
show ?thesis
proof (cases "a ∈ 𝒪")
case True
with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b non_vol)
next
case False
from Cons.prems Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] show ?thesis
by (clarsimp simp add: Read⇩s⇩b non_vol False)
qed
qed
next
case Prog⇩s⇩b
with Cons.hyps [of pending_write 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of pending_write "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "𝒪 ∪ A - R" "𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b in_read_only_convs)
qed
qed
lemma non_volatile_owned_or_read_only_read_only_reads_eq':
"⋀𝒮 𝒮' 𝒪.
⟦non_volatile_owned_or_read_only False 𝒮 𝒪 sb;
∀a ∈ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb). a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'
⟧
⟹ non_volatile_owned_or_read_only False 𝒮' 𝒪 sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
ro': "∀a∈read_only_reads (𝒪 ∪ A - R) sb. a ∈ read_only 𝒮 ⟶ a ∈ read_only 𝒮'"
by (clarsimp simp add: Write⇩s⇩b volatile)
from ro'
have ro'':"∀a∈read_only_reads (𝒪 ∪ A - R) sb.
a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from non_volatile_owned_or_read_only_read_only_reads_eq [OF nvo' ro'']
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case (Read⇩s⇩b volatile a t v)
show ?thesis
proof (cases volatile)
case True
with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case False
note non_vol = this
show ?thesis
proof (cases "a ∈ 𝒪")
case True
with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b non_vol)
next
case False
from Cons.prems Cons.hyps [of 𝒮 𝒪 𝒮'] show ?thesis
by (clarsimp simp add: Read⇩s⇩b non_vol False)
qed
qed
next
case Prog⇩s⇩b
with Cons.hyps [of 𝒮 𝒪 𝒮'] Cons.prems show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "𝒪 ∪ A - R" "𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b in_read_only_convs)
qed
qed
lemma no_write_to_read_only_memory_read_only_reads_eq:
"⋀𝒮 𝒮'.
⟦no_write_to_read_only_memory 𝒮 sb;
∀a ∈ outstanding_refs is_Write⇩s⇩b sb. a ∈ read_only 𝒮' ⟶ a ∈ read_only 𝒮
⟧
⟹ no_write_to_read_only_memory 𝒮' sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "no_write_to_read_only_memory (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb" and
ro': "∀a∈outstanding_refs is_Write⇩s⇩b sb. a ∈ read_only 𝒮' ⟶ a ∈ read_only 𝒮" and
not_ro: "a ∉ read_only 𝒮'"
by (auto simp add: Write⇩s⇩b volatile)
from ro'
have ro'':"∀a∈outstanding_refs is_Write⇩s⇩b sb.
a ∈ read_only (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF nvo' ro''] not_ro
show ?thesis
by (clarsimp simp add: Write⇩s⇩b volatile)
next
case False
with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case (Read⇩s⇩b volatile a t v)
with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case Prog⇩s⇩b
with Cons.hyps [of 𝒮 𝒮'] Cons.prems show ?thesis
by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" "𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b in_read_only_convs)
qed
qed
lemma reads_consistent_drop:
"reads_consistent False 𝒪 m sb
⟹ reads_consistent True
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) m)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
using reads_consistent_append [of False 𝒪 m "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"]
apply (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty)
apply(clarsimp simp add: outstanding_vol_write_take_drop_appends
takeWhile_not_vol_write_outstanding_refs dropWhile_not_vol_write_empty )
apply (case_tac "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)")
apply (fastforce simp add: outstanding_refs_conv)
apply (frule dropWhile_ConsD)
apply (clarsimp split: memref.splits)
done
lemma outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired_dropWhile':
"⋀m 𝒮 𝒪 pending_write.
⟦reads_consistent pending_write 𝒪 m sb;non_volatile_owned_or_read_only pending_write 𝒮 𝒪 sb;
a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)⟧
⟹ a ∈ 𝒪 ∨ a ∈ all_acquired sb ∨
a ∈ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
non_vo: "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
(𝒪 ∪ A - R) sb" and
out_vol: "outstanding_refs is_volatile_Read⇩s⇩b sb = {}" and
out: "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ 𝒪")
case True
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True volatile)
next
case False
from outstanding_non_volatile_Read⇩s⇩b_acquired_or_read_only_reads [OF non_vo out]
have a_in: "a ∈ acquired_reads True sb (𝒪 ∪ A - R) ∨
a ∈ read_only_reads (𝒪 ∪ A - R) sb"
by auto
with acquired_reads_all_acquired [of True sb "(𝒪 ∪ A - R)"]
show ?thesis
by (auto simp add: Write⇩s⇩b volatile)
qed
next
case False
with Cons show ?thesis
by (auto simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b
with Cons show ?thesis
apply (clarsimp simp del: o_apply simp add: Read⇩s⇩b
acquired_takeWhile_non_volatile_Write⇩s⇩b split: if_split_asm)
apply auto
done
next
case Prog⇩s⇩b
with Cons show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [of pending_write "𝒪 ∪ A - R" "m" "𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"] read_only_reads_antimono [of 𝒪 "𝒪 ∪ A - R"]
Cons.prems show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
end
Theory ReduceStoreBufferSimulation
theory ReduceStoreBufferSimulation
imports ReduceStoreBuffer
begin
locale initial⇩s⇩b = simple_ownership_distinct + read_only_unowned + unowned_shared +
constrains ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes empty_sb: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ sb=[]"
assumes empty_is: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ is=[]"
assumes empty_rels: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ ℛ=Map.empty"
sublocale initial⇩s⇩b ⊆ outstanding_non_volatile_refs_owned_or_read_only
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "non_volatile_owned_or_read_only False 𝒮 𝒪 sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ outstanding_volatile_writes_unowned_by_others
proof
fix i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume i_bound: "i < length ts" and
j_bound: "j < length ts" and
neq_i_j: "i ≠ j" and
ts_i: "ts ! i = (p⇩i, is⇩i, θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i, ℛ⇩i)" and
ts_j: "ts ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩i = {}"
using empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j] by auto
qed
sublocale initial⇩s⇩b ⊆ read_only_reads_unowned
proof
fix i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume i_bound: "i < length ts" and
j_bound: "j < length ts" and
neq_i_j: "i ≠ j" and
ts_i: "ts ! i = (p⇩i, is⇩i, θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i, ℛ⇩i)" and
ts_j: "ts ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩
read_only_reads (acquired True
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) 𝒪⇩i)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩i) = {}"
using empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j] by auto
qed
sublocale initial⇩s⇩b ⊆ ownership_distinct
proof
fix i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume i_bound: "i < length ts" and
j_bound: "j < length ts" and
neq_i_j: "i ≠ j" and
ts_i: "ts ! i = (p⇩i, is⇩i, θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i, ℛ⇩i)" and
ts_j: "ts ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
show "(𝒪⇩i ∪ all_acquired sb⇩i) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
using simple_ownership_distinct [OF i_bound j_bound neq_i_j ts_i ts_j] empty_sb [OF i_bound ts_i] empty_sb [OF j_bound ts_j]
by auto
qed
sublocale initial⇩s⇩b ⊆ valid_ownership ..
sublocale initial⇩s⇩b ⊆ outstanding_non_volatile_writes_unshared
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "non_volatile_writes_unshared 𝒮 sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ sharing_consis
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "sharing_consistent 𝒮 𝒪 sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ no_outstanding_write_to_read_only_memory
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "no_write_to_read_only_memory 𝒮 sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ valid_sharing ..
sublocale initial⇩s⇩b ⊆ valid_ownership_and_sharing ..
sublocale initial⇩s⇩b ⊆ load_tmps_distinct
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "distinct_load_tmps is"
using empty_is [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ read_tmps_distinct
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "distinct_read_tmps sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ load_tmps_read_tmps_distinct
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "load_tmps is ∩ read_tmps sb = {}"
using empty_sb [OF i_bound ts_i] empty_is [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ load_tmps_read_tmps_distinct ..
sublocale initial⇩s⇩b ⊆ valid_write_sops
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "∀sop ∈ write_sops sb. valid_sop sop"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ valid_store_sops
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "∀sop ∈ store_sops is. valid_sop sop"
using empty_is [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ valid_sops ..
sublocale initial⇩s⇩b ⊆ valid_reads
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "reads_consistent False 𝒪 m sb"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ valid_history
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "program.history_consistent program_step θ (hd_prog p sb) sb"
using empty_sb [OF i_bound ts_i] by (auto simp add: program.history_consistent.simps)
qed
sublocale initial⇩s⇩b ⊆ valid_data_dependency
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "data_dependency_consistent_instrs (dom θ) is"
using empty_is [OF i_bound ts_i] by auto
next
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "load_tmps is ∩ ⋃(fst ` write_sops sb) = {}"
using empty_is [OF i_bound ts_i] empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ load_tmps_fresh
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "load_tmps is ∩ dom θ = {}"
using empty_is [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ enough_flushs
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
using empty_sb [OF i_bound ts_i] by auto
qed
sublocale initial⇩s⇩b ⊆ valid_program_history
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p sb⇩1 sb⇩2
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assume sb: "sb=sb⇩1@sb⇩2"
show "∃isa. instrs sb⇩2 @ is = isa @ prog_instrs sb⇩2"
using empty_sb [OF i_bound ts_i] empty_is [OF i_bound ts_i] sb by auto
next
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "last_prog p sb = p"
using empty_sb [OF i_bound ts_i] by auto
qed
inductive
sim_config:: "('p,'p store_buffer,bool,owns,rels) thread_config list × memory × shared ⇒
('p, unit,bool,owns,rels) thread_config list × memory × shared ⇒ bool"
("_ ∼ _" [60,60] 100)
where
"⟦m = flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b;
𝒮 = share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b;
length ts⇩s⇩b = length ts;
∀i < length ts⇩s⇩b.
let (p, is⇩s⇩b, θ, sb, 𝒟⇩s⇩b, 𝒪, ℛ) = ts⇩s⇩b!i;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends ∧
𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts!i = (hd_prog p suspends,
is,
θ |` (dom θ - read_tmps suspends),(),
𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪,
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮⇩s⇩b) ℛ )
⟧
⟹
(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
text ‹The machine without
history only stores writes in the store-buffer.›
inductive sim_history_config::
"('p,'p store_buffer,'dirty,'owns,'rels) thread_config list ⇒ ('p,'p store_buffer,bool,owns,rels) thread_config list ⇒ bool"
("_ ∼⇩h _ " [60,60] 100)
where
"⟦length ts = length ts⇩h;
∀i < length ts.
(∃𝒪' 𝒟' ℛ'.
let (p,is, θ, sb,𝒟, 𝒪,ℛ) = ts⇩h!i in
ts!i=(p,is, θ, filter is_Write⇩s⇩b sb,𝒟',𝒪',ℛ') ∧
(filter is_Write⇩s⇩b sb = [] ⟶ sb=[]))
⟧
⟹
ts ∼⇩h ts⇩h"
lemma (in initial⇩s⇩b) history_refl:"ts ∼⇩h ts"
apply -
apply (rule sim_history_config.intros)
apply simp
apply clarsimp
subgoal for i
apply (case_tac "ts!i")
apply (drule_tac i=i in empty_sb)
apply assumption
apply auto
done
done
lemma share_all_empty: "∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts ⟶ ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]
⟹ share_all_until_volatile_write ts 𝒮 = 𝒮"
apply (induct ts)
apply clarsimp
apply clarsimp
apply (frule_tac x=0 in spec)
apply clarsimp
apply force
done
lemma flush_all_empty: "∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts ⟶ ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]
⟹ flush_all_until_volatile_write ts m = m"
apply (induct ts)
apply clarsimp
apply clarsimp
apply (frule_tac x=0 in spec)
apply clarsimp
apply force
done
lemma sim_config_emptyE:
assumes empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩s⇩b ⟶ ts⇩s⇩b!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
shows "𝒮 = 𝒮⇩s⇩b ∧ m = m⇩s⇩b ∧ length ts = length ts⇩s⇩b ∧
(∀i < length ts⇩s⇩b.
let (p, is, θ, sb, 𝒟, 𝒪, ℛ) = ts⇩s⇩b!i
in ts!i = (p, is, θ, (), 𝒟, 𝒪, ℛ))"
proof -
from sim
show ?thesis
apply cases
apply (clarsimp simp add: flush_all_empty [OF empty] share_all_empty [OF empty])
subgoal for i
apply (drule_tac x=i in spec)
apply (cut_tac i=i in empty [rule_format])
apply clarsimp
apply assumption
apply (auto simp add: Let_def)
done
done
qed
lemma sim_config_emptyI:
assumes empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩s⇩b ⟶ ts⇩s⇩b!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
assumes leq: "length ts = length ts⇩s⇩b"
assumes ts: "(∀i < length ts⇩s⇩b.
let (p, is, θ, sb, 𝒟, 𝒪, ℛ) = ts⇩s⇩b!i
in ts!i = (p, is, θ, (), 𝒟, 𝒪, ℛ))"
shows "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m⇩s⇩b,𝒮⇩s⇩b)"
apply (rule sim_config.intros)
apply (simp add: flush_all_empty [OF empty])
apply (simp add: share_all_empty [OF empty])
apply (simp add: leq)
apply (clarsimp)
apply (frule (1) empty [rule_format])
using ts
apply (auto simp add: Let_def)
done
lemma mem_eq_un_eq: "⟦length ts'=length ts; ∀i< length ts'. P (ts'!i) = Q (ts!i) ⟧ ⟹ (⋃x∈set ts'. P x) = (⋃x∈set ts. Q x)"
apply (auto simp add: in_set_conv_nth )
apply (force dest!: nth_mem)
apply (frule nth_mem)
subgoal for x i
apply (drule_tac x=i in spec)
apply auto
done
done
lemma (in program) trace_to_steps:
assumes trace: "trace c 0 k"
shows steps: "c 0 ⇒⇩d⇧* c k"
using trace
proof (induct k)
case 0
show "c 0 ⇒⇩d⇧* c 0"
by auto
next
case (Suc k)
have prem: "trace c 0 (Suc k)" by fact
hence "trace c 0 k"
by (auto simp add: program_trace_def)
from Suc.hyps [OF this]
have "c 0 ⇒⇩d⇧* c k" .
also
term program_trace
from prem interpret program_trace program_step c 0 "Suc k" .
from step [of k] have "c (k) ⇒⇩d c (Suc k)"
by auto
finally show ?case .
qed
lemma (in program) safe_reach_to_safe_reach_upto:
assumes safe_reach: "safe_reach_direct safe c⇩0"
shows "safe_reach_upto n safe c⇩0"
proof
fix k c l
assume k_n: "k ≤ n"
assume trace: "trace c 0 k"
assume c_0: "c 0 = c⇩0"
assume l_k: "l ≤ k"
show "safe (c l)"
proof -
from trace k_n l_k have trace': "trace c 0 l"
by (auto simp add: program_trace_def)
from trace_to_steps [OF trace']
have "c 0 ⇒⇩d⇧* c l".
with safe_reach c_0 show "safe (c l)"
by (cases "c l") (auto simp add: safe_reach_def)
qed
qed
lemma (in program_progress) safe_free_flowing_implies_safe_delayed':
assumes init: "initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes safe_reach_ff: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "safe_reach_direct safe_delayed (ts,m,𝒮)"
proof -
from init
interpret ini: initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b .
from sim obtain
m: "m = flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b" and
𝒮: "𝒮 = share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b" and
leq: "length ts⇩s⇩b = length ts" and
t_sim: "∀i < length ts⇩s⇩b.
let (p, is⇩s⇩b, θ, sb, 𝒟⇩s⇩b, 𝒪, ℛ) = ts⇩s⇩b!i;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends ∧
𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts!i = (hd_prog p suspends,
is,
θ |` (dom θ - read_tmps suspends),(),
𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪,
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮⇩s⇩b) ℛ )"
by cases auto
from ini.empty_sb
have shared_eq: "𝒮 = 𝒮⇩s⇩b"
apply (simp only: 𝒮)
apply (rule share_all_empty)
apply force
done
have sd: "simple_ownership_distinct ts"
proof
fix i j p⇩i is⇩i 𝒪⇩i ℛ⇩i 𝒟⇩i θ⇩i sb⇩i p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume i_bound: "i < length ts" and
j_bound: "j < length ts" and
neq_i_j: "i ≠ j" and
ts_i: "ts ! i = (p⇩i, is⇩i, θ⇩i, sb⇩i, 𝒟⇩i, 𝒪⇩i, ℛ⇩i)" and
ts_j: "ts ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
show "(𝒪⇩i) ∩ (𝒪⇩j ) = {}"
proof -
from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
have ts_i: "ts⇩s⇩b!i = (p⇩i,is⇩i,θ⇩i,[],𝒟⇩i,𝒪⇩i,ℛ⇩i)"
using ts_i
by (force simp add: Let_def)
from t_sim [simplified leq, rule_format, OF j_bound] ini.empty_sb [simplified leq, OF j_bound]
have ts_j: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,[],𝒟⇩j,𝒪⇩j,ℛ⇩j)"
using ts_j
by (force simp add: Let_def)
from ini.simple_ownership_distinct [simplified leq, OF i_bound j_bound neq_i_j ts_i ts_j]
show ?thesis .
qed
qed
have ro: "read_only_unowned 𝒮 ts"
proof
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
show "𝒪 ∩ read_only 𝒮 = {}"
proof -
from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
have ts_i: "ts⇩s⇩b!i = (p,is,θ,[],𝒟,𝒪,ℛ)"
using ts_i
by (force simp add: Let_def)
from ini.read_only_unowned [simplified leq, OF i_bound ts_i] shared_eq
show ?thesis by simp
qed
qed
have us: "unowned_shared 𝒮 ts"
proof
show "- (⋃((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts)) ⊆ dom 𝒮"
proof -
have "(⋃((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts⇩s⇩b)) = (⋃((λ(_, _, _, _, _, 𝒪, _). 𝒪) ` set ts))"
apply clarsimp
apply (rule mem_eq_un_eq)
apply (simp add: leq)
apply clarsimp
apply (frule t_sim [rule_format])
apply (clarsimp simp add: Let_def)
apply (drule (1) ini.empty_sb)
apply auto
done
with ini.unowned_shared show ?thesis by (simp only: shared_eq)
qed
qed
{
fix i "is" 𝒪 ℛ 𝒟 θ sb p
assume i_bound: "i < length ts"
assume ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
have "ℛ = Map.empty"
proof -
from t_sim [simplified leq, rule_format, OF i_bound] ini.empty_sb [simplified leq, OF i_bound]
have ts_i: "ts⇩s⇩b!i = (p,is,θ,[],𝒟,𝒪,ℛ)"
using ts_i
by (force simp add: Let_def)
from ini.empty_rels [simplified leq, OF i_bound ts_i]
show ?thesis .
qed
}
with us have initial: "initial (ts, m, 𝒮)"
by (fastforce simp add: initial_def)
{
fix ts' 𝒮' m'
assume steps: "(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')"
have "safe_delayed (ts',m',𝒮')"
proof -
from steps_to_trace [OF steps] obtain c k
where trace: "trace c 0 k" and c_0: "c 0 = (ts,m,𝒮)" and c_k: "c k = (ts',m',𝒮')"
by auto
from safe_reach_to_safe_reach_upto [OF safe_reach_ff]
have safe_upto_k: "safe_reach_upto k safe_free_flowing (ts, m, 𝒮)".
from safe_free_flowing_implies_safe_delayed [OF _ _ _ _ safe_upto_k, simplified, OF initial sd ro us]
have "safe_reach_upto k safe_delayed (ts, m, 𝒮)".
then interpret program_safe_reach_upto program_step k safe_delayed "(ts,m,𝒮)" .
from safe_config [where c=c and k=k and l=k, OF _ trace c_0] c_k show ?thesis by simp
qed
}
then show ?thesis
by (clarsimp simp add: safe_reach_def)
qed
lemma map_onws_sb_owned:"⋀j. j < length ts ⟹ map 𝒪_sb ts ! j = (𝒪⇩j,sb⇩j) ⟹ map owned ts ! j = 𝒪⇩j"
apply (induct ts)
apply simp
subgoal for t ts j
apply (case_tac j)
apply (case_tac t)
apply auto
done
done
lemma map_onws_sb_owned':"⋀j. j < length ts ⟹ 𝒪_sb (ts ! j) = (𝒪⇩j,sb⇩j) ⟹ owned (ts ! j) = 𝒪⇩j"
apply (induct ts)
apply simp
subgoal for t ts j
apply (case_tac j)
apply (case_tac t)
apply auto
done
done
lemma read_only_read_acquired_unforwarded_acquire_witness:
"⋀𝒮 𝒪 X.⟦non_volatile_owned_or_read_only True 𝒮 𝒪 sb;
sharing_consistent 𝒮 𝒪 sb; a ∉ read_only 𝒮; a ∉ 𝒪;
a ∈ unforwarded_non_volatile_reads sb X⟧
⟹(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (clarsimp simp add: Write⇩s⇩b True)
from unforwarded_not_written [OF a_unforw]
have a_notin: "a ∉ insert a' X".
hence a'_a: "a' ≠ a"
by simp
from R_owns a_unowned
have a_R: "a ∉ R"
by auto
show ?thesis
proof (cases "a ∈ A")
case True
then show ?thesis
apply -
apply (rule disjI1)
apply (rule_tac x=sop in exI)
apply (rule_tac x=a' in exI)
apply (rule_tac x=v in exI)
apply (rule_tac x="[]" in exI)
apply (rule_tac x=sb in exI)
apply (simp add: Write⇩s⇩b volatile True a'_a)
done
next
case False
with a_unowned R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_unforw]
have "(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
(is "?write ∨ ?ghst")
by simp
then show ?thesis
proof
assume ?write
then obtain sop' a'' v' ys zs A' L' R' W' where
sb: "sb = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'' ≠ a"
by auto
show ?thesis
using props False a_notin sb
apply -
apply (rule disjI1)
apply (rule_tac x=sop' in exI)
apply (rule_tac x=a'' in exI)
apply (rule_tac x=v' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Write⇩s⇩b volatile False a'_a)
done
next
assume ?ghst
then obtain ys zs A' L' R' W' where
sb: "sb = ys @ Ghost⇩s⇩b A' L' R' W'# zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys"
by auto
show ?thesis
using props False a_notin sb
apply -
apply (rule disjI2)
apply (rule_tac x=A' in exI)
apply (rule_tac x=L' in exI)
apply (rule_tac x=R' in exI)
apply (rule_tac x=W' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Write⇩s⇩b volatile False a'_a)
done
qed
qed
next
case False
from Cons.prems obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
a_ro': "a' ∈ 𝒪" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw': "a ∈ unforwarded_non_volatile_reads sb (insert a' X)"
by (auto simp add: Write⇩s⇩b False split: if_split_asm)
from unforwarded_not_written [OF a_unforw']
have a_notin: "a ∉ insert a' X".
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw']
have "(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
(is "?write ∨ ?ghst")
by simp
then show ?thesis
proof
assume ?write
then obtain sop' a'' v' ys zs A' L' R' W' where
sb: "sb = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'' ≠ a"
by auto
show ?thesis
using props False a_notin sb
apply -
apply (rule disjI1)
apply (rule_tac x=sop' in exI)
apply (rule_tac x=a'' in exI)
apply (rule_tac x=v' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Write⇩s⇩b False )
done
next
assume ?ghst
then obtain ys zs A' L' R' W' where
sb: "sb = ys @ Ghost⇩s⇩b A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys"
by auto
show ?thesis
using props False a_notin sb
apply -
apply (rule disjI2)
apply (rule_tac x=A' in exI)
apply (rule_tac x=L' in exI)
apply (rule_tac x=R' in exI)
apply (rule_tac x=W' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Write⇩s⇩b False )
done
qed
qed
next
case (Read⇩s⇩b volatile a' t v)
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Read⇩s⇩b split: if_split_asm)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw]
have "(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
(is "?write ∨ ?ghst")
by simp
then show ?thesis
proof
assume ?write
then obtain sop' a'' v' ys zs A' L' R' W' where
sb: "sb = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'' ≠ a"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI1)
apply (rule_tac x=sop' in exI)
apply (rule_tac x=a'' in exI)
apply (rule_tac x=v' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Read⇩s⇩b)
done
next
assume ?ghst
then obtain ys zs A' L' R' W' where
sb: "sb = ys @ Ghost⇩s⇩b A' L' R' W'# zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI2)
apply (rule_tac x=A' in exI)
apply (rule_tac x=L' in exI)
apply (rule_tac x=R' in exI)
apply (rule_tac x=W' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Read⇩s⇩b )
done
qed
next
case Prog⇩s⇩b
from Cons.prems
obtain
consis': "sharing_consistent 𝒮 𝒪 sb" and
a_nro': "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
nvo': "non_volatile_owned_or_read_only True 𝒮 𝒪 sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (auto simp add: Prog⇩s⇩b)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned a_unforw]
have "(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
(is "?write ∨ ?ghst")
by simp
then show ?thesis
proof
assume ?write
then obtain sop' a'' v' ys zs A' L' R' W' where
sb: "sb = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'' ≠ a"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI1)
apply (rule_tac x=sop' in exI)
apply (rule_tac x=a'' in exI)
apply (rule_tac x=v' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Prog⇩s⇩b)
done
next
assume ?ghst
then obtain ys zs A' L' R' W' where
sb: "sb = ys @ Ghost⇩s⇩b A' L' R' W'# zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI2)
apply (rule_tac x=A' in exI)
apply (rule_tac x=L' in exI)
apply (rule_tac x=R' in exI)
apply (rule_tac x=W' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Prog⇩s⇩b )
done
qed
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
nvo': "non_volatile_owned_or_read_only True (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_nro: "a ∉ read_only 𝒮" and
a_unowned: "a ∉ 𝒪" and
A_shared_owns: "A ⊆ dom 𝒮 ∪ 𝒪" and L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and
consis': "sharing_consistent (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪 ∪ A - R) sb" and
a_unforw: "a ∈ unforwarded_non_volatile_reads sb X"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ A")
case True
then show ?thesis
apply -
apply (rule disjI2)
apply (rule_tac x=A in exI)
apply (rule_tac x=L in exI)
apply (rule_tac x=R in exI)
apply (rule_tac x=W in exI)
apply (rule_tac x="[]" in exI)
apply (rule_tac x=sb in exI)
apply (simp add: Ghost⇩s⇩b True)
done
next
case False
with a_unowned a_nro L_A R_owns a_nro L_A A_R
obtain a_nro': "a ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" and a_unowned': "a ∉ 𝒪 ∪ A - R"
by (force simp add: in_read_only_convs)
from Cons.hyps [OF nvo' consis' a_nro' a_unowned' a_unforw]
have "(∃sop a' v ys zs A L R W.
sb = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧
a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a' ≠ a) ∨
(∃A L R W ys zs. sb = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys)"
(is "?write ∨ ?ghst")
by simp
then show ?thesis
proof
assume ?write
then obtain sop' a'' v' ys zs A' L' R' W' where
sb: "sb = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'' ≠ a"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI1)
apply (rule_tac x=sop' in exI)
apply (rule_tac x=a'' in exI)
apply (rule_tac x=v' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Ghost⇩s⇩b False )
done
next
assume ?ghst
then obtain ys zs A' L' R' W' where
sb: "sb = ys @ Ghost⇩s⇩b A' L' R' W'# zs" and
props: "a ∈ A'" "a ∉ outstanding_refs is_Write⇩s⇩b ys"
by auto
show ?thesis
using props sb
apply -
apply (rule disjI2)
apply (rule_tac x=A' in exI)
apply (rule_tac x=L' in exI)
apply (rule_tac x=R' in exI)
apply (rule_tac x=W' in exI)
apply (rule_tac x="(x#ys)" in exI)
apply (rule_tac x=zs in exI)
apply (simp add: Ghost⇩s⇩b False )
done
qed
qed
qed
qed
lemma release_shared_exchange_weak:
assumes shared_eq: "∀a ∈ 𝒪 ∪ all_acquired sb. (𝒮'::shared) a = 𝒮 a"
assumes consis: "weak_sharing_consistent 𝒪 sb"
shows "release sb (dom 𝒮') ℛ = release sb (dom 𝒮) ℛ"
using shared_eq consis
proof (induct sb arbitrary: 𝒮 𝒮' 𝒪 ℛ)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ 𝒪 ∪ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Write⇩s⇩b True )
from shared_eq
have shared_eq': "∀a∈𝒪 ∪ A - R ∪ all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from Cons.hyps [OF shared_eq' consis']
have "release sb (dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty = release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty" .
then show ?thesis
by (auto simp add: Write⇩s⇩b True domIff)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis
by auto
next
case Prog⇩s⇩b with Cons show ?thesis
by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
shared_eq: "∀a ∈ 𝒪 ∪ A ∪ all_acquired sb. 𝒮' a = 𝒮 a"
by (clarsimp simp add: Ghost⇩s⇩b )
from shared_eq
have shared_eq': "∀a∈𝒪 ∪ A - R ∪ all_acquired sb. (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L) a = (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a"
by (auto simp add: augment_shared_def restrict_shared_def)
from shared_eq R_owns have "∀a∈R. (a ∈ dom 𝒮) = (a ∈ dom 𝒮')"
by (auto simp add: domIff)
from augment_rels_shared_exchange [OF this]
have "(augment_rels (dom 𝒮') R ℛ) = (augment_rels (dom 𝒮) R ℛ)".
with Cons.hyps [OF shared_eq' consis']
have "release sb (dom (𝒮' ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮') R ℛ) =
release sb (dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮) R ℛ)" by simp
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b domIff)
qed
qed
lemma read_only_share_all_shared: "⋀𝒮. ⟦ a ∈ read_only (share sb 𝒮)⟧
⟹ a ∈ read_only 𝒮 ∪ all_shared sb"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a sop v A L R W)
show ?thesis
proof (cases volatile)
case True
with Write⇩s⇩b Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"] Cons.prems
show ?thesis
by (auto simp add: read_only_def augment_shared_def restrict_shared_def
split: if_split_asm option.splits)
next
case False with Write⇩s⇩b Cons show ?thesis by auto
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
with Cons.hyps [of "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"] Cons.prems
show ?thesis
by (auto simp add: read_only_def augment_shared_def restrict_shared_def
split: if_split_asm option.splits)
qed
qed
lemma read_only_shared_all_until_volatile_write_subset':
"⋀𝒮.
read_only (share_all_until_volatile_write ts 𝒮) ⊆
read_only 𝒮 ∪ (⋃((λ(_, _, _, sb, _, _ ,_). all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p "is" 𝒪 ℛ 𝒟 θ sb where
t: "t = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
{
fix a
assume a_in: "a ∈ read_only
(share_all_until_volatile_write ts
(share ?take_sb 𝒮))" and
a_notin_shared: "a ∉ read_only 𝒮" and
a_notin_rest: "a ∉ (⋃((λ(_, _, _, sb, _, _ ,_). all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts))"
have "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
proof -
from Cons.hyps [of "(share ?take_sb 𝒮)"] a_in a_notin_rest
have "a ∈ read_only (share ?take_sb 𝒮)"
by (auto simp add: aargh)
from read_only_share_all_shared [OF this] a_notin_shared
show ?thesis by auto
qed
}
then show ?case
by (auto simp add: t aargh)
qed
lemma read_only_share_acquired_all_shared:
"⋀𝒪 𝒮. weak_sharing_consistent 𝒪 sb ⟹ 𝒪 ∩ read_only 𝒮 = {} ⟹
a ∈ read_only (share sb 𝒮) ⟹ a ∈ 𝒪 ∪ all_acquired sb ⟹ a ∈ all_shared sb"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_share: "a ∈ read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
a_A_all: "a ∈ 𝒪 ∪ A ∪ all_acquired sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF consis' owns_ro' a_share]
show ?thesis
using L_A A_R R_owns owns_ro a_A_all
by (auto simp add: Write⇩s⇩b volatile augment_shared_def restrict_shared_def read_only_def domIff
split: if_split_asm)
next
case False
with Cons Write⇩s⇩b show ?thesis by (auto)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_share: "a ∈ read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
a_A_all: "a ∈ 𝒪 ∪ A ∪ all_acquired sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF consis' owns_ro' a_share]
show ?thesis
using L_A A_R R_owns owns_ro a_A_all
by (auto simp add: Ghost⇩s⇩b augment_shared_def restrict_shared_def read_only_def domIff
split: if_split_asm)
qed
qed
lemma read_only_share_unowned': "⋀𝒪 𝒮.
⟦weak_sharing_consistent 𝒪 sb; 𝒪 ∩ read_only 𝒮 = {}; a ∉ 𝒪 ∪ all_acquired sb; a ∈ read_only 𝒮⟧
⟹ a ∈ read_only (share sb 𝒮)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case False
with Cons Write⇩s⇩b show ?thesis by auto
next
case True
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_share: "a ∈ read_only 𝒮" and
a_notin: "a ∉ 𝒪" "a ∉ A" "a ∉ all_acquired sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_notin have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from a_share a_notin L_A A_R R_owns have a_ro': "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: read_only_def restrict_shared_def augment_shared_def)
from Cons.hyps [OF consis' owns_ro' a_notin' a_ro']
have "a ∈ read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
then show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
owns_ro: "𝒪 ∩ read_only 𝒮 = {}" and L_A: " L ⊆ A" and A_R: "A ∩ R = {}" and
R_owns: "R ⊆ 𝒪" and consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_share: "a ∈ read_only 𝒮" and
a_notin: "a ∉ 𝒪" "a ∉ A" "a ∉ all_acquired sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_notin have a_notin': "a ∉ 𝒪 ∪ A - R ∪ all_acquired sb"
by auto
from a_share a_notin L_A A_R R_owns have a_ro': "a ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: read_only_def restrict_shared_def augment_shared_def)
from Cons.hyps [OF consis' owns_ro' a_notin' a_ro']
have "a ∈ read_only (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
then show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma release_False_mono:
"⋀S ℛ. ℛ a = Some False ⟹ outstanding_refs is_volatile_Write⇩s⇩b sb = {} ⟹
release sb S ℛ a = Some False "
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Ghost⇩s⇩b A L R W)
have rels_a: "ℛ a = Some False" by fact
then have "(augment_rels S R ℛ) a = Some False"
by (auto simp add: augment_rels_def)
from Cons.hyps [where ℛ = "(augment_rels S R ℛ)", OF this] Cons.prems
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case Write⇩s⇩b with Cons show ?thesis by auto
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma release_False_mono_take:
"⋀S ℛ. ℛ a = Some False ⟹ release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S ℛ a = Some False "
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Ghost⇩s⇩b A L R W)
have rels_a: "ℛ a = Some False" by fact
then have "(augment_rels S R ℛ) a = Some False"
by (auto simp add: augment_rels_def)
from Cons.hyps [where ℛ = "(augment_rels S R ℛ)", OF this]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
next
case Write⇩s⇩b with Cons show ?thesis by auto
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma shared_switch:
"⋀𝒮 𝒪. ⟦weak_sharing_consistent 𝒪 sb; read_only 𝒮 ∩ 𝒪 = {};
𝒮 a ≠ Some False; share sb 𝒮 a = Some False⟧
⟹ a ∈ 𝒪 ∪ all_acquired sb "
proof (induct sb)
case Nil thus ?case by (auto simp add: read_only_def)
next
case (Cons x sb)
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases x)
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
dist: "read_only 𝒮 ∩ 𝒪 = {}" and
share: "𝒮 a ≠ Some False" and
share': "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = Some False" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" by (clarsimp simp add: Ghost⇩s⇩b aargh)
from dist L_A A_R R_owns have dist': "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∩ (𝒪 ∪ A - R)= {}"
by (auto simp add: in_read_only_convs)
show ?thesis
proof (cases "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = Some False")
case False
from Cons.hyps [OF consis' dist' this share']
show ?thesis by (auto simp add: Ghost⇩s⇩b)
next
case True
with share L_A A_R R_owns dist
have "a ∈ 𝒪 ∪ A"
by (cases "𝒮 a")
(auto simp add: augment_shared_def restrict_shared_def read_only_def split: if_split_asm )
thus ?thesis by (auto simp add: Ghost⇩s⇩b)
qed
next
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems obtain
dist: "read_only 𝒮 ∩ 𝒪 = {}" and
share: "𝒮 a ≠ Some False" and
share': "share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = Some False" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" by (clarsimp simp add: Write⇩s⇩b True aargh)
from dist L_A A_R R_owns have dist': "read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ∩ (𝒪 ∪ A - R)= {}"
by (auto simp add: in_read_only_convs)
show ?thesis
proof (cases "(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) a = Some False")
case False
from Cons.hyps [OF consis' dist' this share']
show ?thesis by (auto simp add: Write⇩s⇩b True)
next
case True
with share L_A A_R R_owns dist
have "a ∈ 𝒪 ∪ A"
by (cases "𝒮 a")
(auto simp add: augment_shared_def restrict_shared_def read_only_def split: if_split_asm )
thus ?thesis by (auto simp add: Write⇩s⇩b volatile)
qed
next
case False
with Cons show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (auto)
next
case Prog⇩s⇩b with Cons show ?thesis by (auto)
qed
qed
lemma shared_switch_release_False:
"⋀𝒮 ℛ. ⟦
outstanding_refs is_volatile_Write⇩s⇩b sb = {};
a ∉ dom 𝒮;
a ∈ dom (share sb 𝒮)⟧
⟹
release sb (dom 𝒮) ℛ a = Some False"
proof (induct sb)
case Nil thus ?case by (auto simp add: read_only_def)
next
case (Cons x sb)
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases x)
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_notin: "a ∉ dom 𝒮" and
share: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
out': "outstanding_refs is_volatile_Write⇩s⇩b sb = {}"
by (clarsimp simp add: Ghost⇩s⇩b aargh)
show ?thesis
proof (cases "a ∈ R")
case False
with a_notin have "a ∉ dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by auto
from Cons.hyps [OF out' this share]
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
next
case True
with a_notin have "augment_rels (dom 𝒮) R ℛ a = Some False"
by (auto simp add: augment_rels_def split: option.splits)
from release_False_mono [of "augment_rels (dom 𝒮) R ℛ", OF this out']
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
next
case Write⇩s⇩b with Cons show ?thesis by (clarsimp split: if_split_asm)
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
qed
qed
lemma release_not_unshared_no_write:
"⋀𝒮 ℛ. ⟦
outstanding_refs is_volatile_Write⇩s⇩b sb = {};
non_volatile_writes_unshared 𝒮 sb;
release sb (dom 𝒮) ℛ a ≠ Some False;
a ∈ dom (share sb 𝒮)⟧
⟹
a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb"
proof (induct sb)
case Nil thus ?case by (auto simp add: read_only_def)
next
case (Cons x sb)
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
show ?case
proof (cases x)
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
share: "a ∈ dom (share sb (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
rel: "release sb
(dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) (augment_rels (dom 𝒮) R ℛ) a ≠ Some False" and
out': "outstanding_refs is_volatile_Write⇩s⇩b sb = {}" and
nvu: "non_volatile_writes_unshared (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) sb"
by (clarsimp simp add: Ghost⇩s⇩b )
from Cons.hyps [OF out' nvu rel share]
show ?thesis by (auto simp add: Ghost⇩s⇩b)
next
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True with Write⇩s⇩b Cons.prems have False by auto
thus ?thesis ..
next
case False
note not_vol = this
from Cons.prems obtain
rel: "release sb (dom 𝒮) ℛ a ≠ Some False" and
out': "outstanding_refs is_volatile_Write⇩s⇩b sb = {}" and
nvo: "non_volatile_writes_unshared 𝒮 sb" and
a'_not_dom: "a' ∉ dom 𝒮" and
a_dom: "a ∈ dom (share sb 𝒮)"
by (auto simp add: Write⇩s⇩b False)
from Cons.hyps [OF out' nvo rel a_dom]
have a_notin_rest: "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb".
show ?thesis
proof (cases "a'=a")
case False with a_notin_rest
show ?thesis by (clarsimp simp add: Write⇩s⇩b not_vol )
next
case True
from shared_switch_release_False [OF out' a'_not_dom [simplified True] a_dom]
have "release sb (dom 𝒮) ℛ a = Some False".
with rel have False by simp
thus ?thesis ..
qed
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
qed
qed
corollary release_not_unshared_no_write_take:
assumes nvw: "non_volatile_writes_unshared 𝒮 (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
assumes rel: "release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮) ℛ a ≠ Some False"
assumes a_in: "a ∈ dom (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
shows
"a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
using release_not_unshared_no_write[OF takeWhile_not_vol_write_outstanding_refs [of sb] nvw rel a_in]
by simp
lemma read_only_unacquired_share':
"⋀S 𝒪. ⟦𝒪 ∩ read_only S = {}; weak_sharing_consistent 𝒪 sb; a ∈ read_only S;
a ∉ all_shared sb; a ∉ acquired True sb 𝒪 ⟧
⟹ a ∈ read_only (share sb S)"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
obtain a_ro: "a ∈ read_only S" and a_R: "a ∉ R" and a_unsh: "a ∉ all_shared sb" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_notin: "a ∉ acquired True sb (𝒪 ∪ A - R)"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ A")
case True
with a_R have "a ∈ 𝒪 ∪ A - R" by auto
from all_shared_acquired_in [OF this a_unsh]
have "a ∈ acquired True sb (𝒪 ∪ A - R)" by auto
with a_notin have False by auto
thus ?thesis ..
next
case False
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_ro False owns_ro R_owns L_A have a_ro': "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro' a_unsh a_notin]
show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
qed
next
case False
with Cons show ?thesis
by (clarsimp simp add: Write⇩s⇩b False)
qed
next
case Read⇩s⇩b with Cons show ?thesis by (clarsimp)
next
case Prog⇩s⇩b with Cons show ?thesis by (clarsimp)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
obtain a_ro: "a ∈ read_only S" and a_R: "a ∉ R" and a_unsh: "a ∉ all_shared sb" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb" and
a_notin: "a ∉ acquired True sb (𝒪 ∪ A - R)"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ A")
case True
with a_R have "a ∈ 𝒪 ∪ A - R" by auto
from all_shared_acquired_in [OF this a_unsh]
have "a ∈ acquired True sb (𝒪 ∪ A - R)" by auto
with a_notin have False by auto
thus ?thesis ..
next
case False
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from a_ro False owns_ro R_owns L_A have a_ro': "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_ro' a_unsh a_notin]
show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma read_only_share_all_until_volatile_write_unacquired':
"⋀𝒮. ⟦ownership_distinct ts; read_only_unowned 𝒮 ts; weak_sharing_consis ts;
∀i < length ts. (let (_,_,_,sb,_,𝒪,ℛ) = ts!i in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
));
a ∈ read_only 𝒮⟧
⟹ a ∈ read_only (share_all_until_volatile_write ts 𝒮)"
proof (induct ts)
case Nil thus ?case by simp
next
case (Cons t ts)
obtain p "is" 𝒪 ℛ 𝒟 θ sb where
t: "t = (p,is,θ,sb,𝒟,𝒪,ℛ)"
by (cases t)
have dist: "ownership_distinct (t#ts)" by fact
then interpret ownership_distinct "t#ts" .
from ownership_distinct_tl [OF dist]
have dist': "ownership_distinct ts".
have aargh: "(Not ∘ is_volatile_Write⇩s⇩b) = (λa. ¬ is_volatile_Write⇩s⇩b a)"
by (rule ext) auto
have a_ro: "a ∈ read_only 𝒮" by fact
have ro_unowned: "read_only_unowned 𝒮 (t#ts)" by fact
then interpret read_only_unowned 𝒮 "t#ts" .
have consis: "weak_sharing_consis (t#ts)" by fact
then interpret weak_sharing_consis "t#ts" .
note consis' = weak_sharing_consis_tl [OF consis]
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from weak_sharing_consis [of 0] t
have consis_sb: "weak_sharing_consistent 𝒪 sb"
by force
with weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
have ro_unowned': "read_only_unowned (share ?take_sb 𝒮) ts"
proof
fix j
fix p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts"
assume jth: "ts!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (share ?take_sb 𝒮) = {}"
proof -
{
fix a
assume a_owns: "a ∈ 𝒪⇩j"
assume a_ro: "a ∈ read_only (share ?take_sb 𝒮)"
have False
proof -
from ownership_distinct [of 0 "Suc j"] j_bound jth t
have dist: "(𝒪 ∪ all_acquired sb) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by fastforce
from read_only_unowned [of "Suc j"] j_bound jth
have dist_ro: "𝒪⇩j ∩ read_only 𝒮 = {}" by force
show ?thesis
proof (cases "a ∈ (𝒪 ∪ all_acquired sb)")
case True
with dist a_owns show False by auto
next
case False
hence "a ∉ (𝒪 ∪ all_acquired ?take_sb)"
using all_acquired_append [of ?take_sb ?drop_sb]
by auto
from read_only_share_unowned [OF consis_take this a_ro]
have "a ∈ read_only 𝒮".
with dist_ro a_owns show False by auto
qed
qed
}
thus ?thesis by auto
qed
qed
from Cons.prems
obtain unacq_ts: "∀i < length ts. (let (_,_,_,sb,_,𝒪,_) = ts!i in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪 ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) " and
unacq_sb: "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪" and
unsh_sb: "a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) "
apply clarsimp
apply (rule that)
apply (auto simp add: t aargh)
done
from read_only_unowned [of 0] t
have owns_ro: "𝒪 ∩ read_only 𝒮 = {}"
by force
from read_only_unacquired_share' [OF owns_ro consis_take a_ro unsh_sb unacq_sb]
have "a ∈ read_only (share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)".
from Cons.hyps [OF dist' ro_unowned' consis' unacq_ts this]
show ?case
by (simp add: t)
qed
lemma not_shared_not_acquired_switch:
"⋀X Y. ⟦a ∉ all_shared sb; a ∉ X; a ∉ acquired True sb X; a ∉ Y⟧ ⟹ a ∉ acquired True sb Y"
proof (induct sb)
case Nil thus ?case by simp
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
from Cons.prems obtain
a_X: "a ∉ X" and a_acq: "a ∉ acquired True sb (X ∪ A - R)" and
a_Y: "a ∉ Y" and a_R: "a ∉ R" and
a_shared: "a ∉ all_shared sb"
by (clarsimp simp add: Write⇩s⇩b True)
show ?thesis
proof (cases "a ∈ A")
case True
with a_X a_R
have "a ∈ X ∪ A - R" by auto
from all_shared_acquired_in [OF this a_shared]
have "a ∈ acquired True sb (X ∪ A - R)".
with a_acq have False by simp
thus ?thesis ..
next
case False
with a_X a_Y obtain a_X': "a ∉ X ∪ A - R" and a_Y': "a ∉ Y ∪ A - R"
by auto
from Cons.hyps [OF a_shared a_X' a_acq a_Y']
show ?thesis
by (auto simp add: Write⇩s⇩b True)
qed
next
case False with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto)
next
case Prog⇩s⇩b with Cons.hyps [of X Y] Cons.prems show ?thesis by (auto)
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems obtain
a_X: "a ∉ X" and a_acq: "a ∉ acquired True sb (X ∪ A - R)" and
a_Y: "a ∉ Y" and a_R: "a ∉ R" and
a_shared: "a ∉ all_shared sb"
by (clarsimp simp add: Ghost⇩s⇩b)
show ?thesis
proof (cases "a ∈ A")
case True
with a_X a_R
have "a ∈ X ∪ A - R" by auto
from all_shared_acquired_in [OF this a_shared]
have "a ∈ acquired True sb (X ∪ A - R)".
with a_acq have False by simp
thus ?thesis ..
next
case False
with a_X a_Y obtain a_X': "a ∉ X ∪ A - R" and a_Y': "a ∉ Y ∪ A - R"
by auto
from Cons.hyps [OF a_shared a_X' a_acq a_Y']
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
qed
lemma read_only_share_all_acquired_in':
"⋀S 𝒪. ⟦𝒪 ∩ read_only S = {}; weak_sharing_consistent 𝒪 sb; a ∈ read_only (share sb S)⟧
⟹ a ∈ read_only (share sb Map.empty) ∨ (a ∈ read_only S ∧ a ∉ acquired True sb 𝒪 ∧ a ∉ all_shared sb )"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.prems
obtain a_in: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Write⇩s⇩b True)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_in]
have hyp: "a ∈ read_only (share sb Map.empty) ∨
(a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ acquired True sb (𝒪 ∪ A - R) ∧ a ∉ all_shared sb)".
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∨
(a ∈ read_only S ∧ a ∉ R ∧ a ∉ acquired True sb (𝒪 ∪ A - R) ∧ a ∉ all_shared sb)"
proof -
{
assume a_emp: "a ∈ read_only (share sb Map.empty)"
have "read_only Map.empty ⊆ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from share_read_only_mono_in [OF a_emp this]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
}
moreover
{
assume a_ro: "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)" and
a_not_acq: "a ∉ acquired True sb (𝒪 ∪ A - R)" and
a_unsh: "a ∉ all_shared sb"
have ?thesis
proof (cases "a ∈ read_only S")
case True
with a_ro obtain a_A: "a ∉ A"
by (auto simp add: in_read_only_convs)
with True a_not_acq a_unsh R_owns owns_ro
show ?thesis
by auto
next
case False
with a_ro have a_ro_empty: "a ∈ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
have "read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
with owns_ro'
have owns_ro_empty: "(𝒪 ∪ A - R) ∩ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by blast
from read_only_unacquired_share' [OF owns_ro_empty consis' a_ro_empty a_unsh a_not_acq]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
thus ?thesis
by simp
qed
}
moreover note hyp
ultimately show ?thesis by blast
qed
then show ?thesis
by (clarsimp simp add: Write⇩s⇩b True)
next
case False with Cons show ?thesis
by (auto simp add: Write⇩s⇩b)
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from Cons.prems
obtain a_in: "a ∈ read_only (share sb (S ⊕⇘W⇙ R ⊖⇘A⇙ L))" and
owns_ro: "𝒪 ∩ read_only S = {}" and
L_A: "L ⊆ A" and A_R: "A ∩ R = {}" and R_owns: "R ⊆ 𝒪" and
consis': "weak_sharing_consistent (𝒪 ∪ A - R) sb"
by (clarsimp simp add: Ghost⇩s⇩b)
from owns_ro A_R R_owns have owns_ro': "(𝒪 ∪ A - R) ∩ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs)
from Cons.hyps [OF owns_ro' consis' a_in]
have hyp: "a ∈ read_only (share sb Map.empty) ∨
(a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L) ∧ a ∉ acquired True sb (𝒪 ∪ A - R) ∧ a ∉ all_shared sb)".
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)) ∨
(a ∈ read_only S ∧ a ∉ R ∧ a ∉ acquired True sb (𝒪 ∪ A - R) ∧ a ∉ all_shared sb)"
proof -
{
assume a_emp: "a ∈ read_only (share sb Map.empty)"
have "read_only Map.empty ⊆ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from share_read_only_mono_in [OF a_emp this]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
}
moreover
{
assume a_ro: "a ∈ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)" and
a_not_acq: "a ∉ acquired True sb (𝒪 ∪ A - R)" and
a_unsh: "a ∉ all_shared sb"
have ?thesis
proof (cases "a ∈ read_only S")
case True
with a_ro obtain a_A: "a ∉ A"
by (auto simp add: in_read_only_convs)
with True a_not_acq a_unsh R_owns owns_ro
show ?thesis
by auto
next
case False
with a_ro have a_ro_empty: "a ∈ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs split: if_split_asm)
have "read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) ⊆ read_only (S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
with owns_ro'
have owns_ro_empty: "(𝒪 ∪ A - R) ∩ read_only (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by blast
from read_only_unacquired_share' [OF owns_ro_empty consis' a_ro_empty a_unsh a_not_acq]
have "a ∈ read_only (share sb (Map.empty ⊕⇘W⇙ R ⊖⇘A⇙ L))".
thus ?thesis
by simp
qed
}
moreover note hyp
ultimately show ?thesis by blast
qed
then show ?thesis
by (clarsimp simp add: Ghost⇩s⇩b)
qed
qed
lemma in_read_only_share_all_until_volatile_write':
assumes dist: "ownership_distinct ts"
assumes consis: "sharing_consis 𝒮 ts"
assumes ro_unowned: "read_only_unowned 𝒮 ts"
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes a_unacquired_others: "∀j < length ts. i≠j ⟶
(let (_,_,_,sb⇩j,_,𝒪,_) = ts!j in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪 ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j ))"
assumes a_ro_share: "a ∈ read_only (share sb 𝒮)"
shows "a ∈ read_only (share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)
(share_all_until_volatile_write ts 𝒮))"
proof -
from consis
interpret sharing_consis 𝒮 ts .
interpret read_only_unowned 𝒮 ts by fact
from sharing_consis [OF i_bound ts_i]
have consis_sb: "sharing_consistent 𝒮 𝒪 sb".
from sharing_consistent_weak_sharing_consistent [OF this]
have weak_consis: "weak_sharing_consistent 𝒪 sb".
from read_only_unowned [OF i_bound ts_i]
have owns_ro: "𝒪 ∩ read_only 𝒮 = {}".
from read_only_share_all_acquired_in' [OF owns_ro weak_consis a_ro_share]
have "a ∈ read_only (share sb Map.empty) ∨ a ∈ read_only 𝒮 ∧ a ∉ acquired True sb 𝒪 ∧ a ∉ all_shared sb".
moreover
let ?take_sb = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
let ?drop_sb = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
obtain weak_consis': "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb" and
weak_consis_take: "weak_sharing_consistent 𝒪 ?take_sb"
by auto
{
assume "a ∈ read_only (share sb Map.empty)"
with share_append [of ?take_sb ?drop_sb]
have a_in': "a ∈ read_only (share ?drop_sb (share ?take_sb Map.empty))"
by auto
have owns_empty: "𝒪 ∩ read_only Map.empty = {}"
by auto
from weak_sharing_consistent_preserves_distinct [OF weak_consis_take owns_empty]
have "acquired True ?take_sb 𝒪 ∩ read_only (share ?take_sb Map.empty) = {}".
from read_only_share_all_acquired_in [OF this weak_consis' a_in']
have "a ∈ read_only (share ?drop_sb Map.empty) ∨ a ∈ read_only (share ?take_sb Map.empty) ∧ a ∉ all_acquired ?drop_sb".
moreover
{
assume a_ro_drop: "a ∈ read_only (share ?drop_sb Map.empty)"
have "read_only Map.empty ⊆ read_only (share_all_until_volatile_write ts 𝒮)"
by auto
from share_read_only_mono_in [OF a_ro_drop this]
have ?thesis .
}
moreover
{
assume a_ro_take: "a ∈ read_only (share ?take_sb Map.empty)"
assume a_unacq_drop: "a ∉ all_acquired ?drop_sb"
from read_only_share_unowned_in [OF weak_consis_take a_ro_take]
have "a ∈ 𝒪 ∪ all_acquired ?take_sb" by auto
hence "a ∈ 𝒪 ∪ all_acquired sb" using all_acquired_append [of ?take_sb ?drop_sb]
by auto
from share_all_until_volatile_write_thread_local' [OF dist consis i_bound ts_i this] a_ro_share
have ?thesis by (auto simp add: read_only_def)
}
ultimately have ?thesis by blast
}
moreover
{
assume a_ro: "a ∈ read_only 𝒮"
assume a_unacq: "a ∉ acquired True sb 𝒪"
assume a_unsh: "a ∉ all_shared sb"
with all_shared_append [of ?take_sb ?drop_sb]
obtain a_notin_take: "a ∉ all_shared ?take_sb" and a_notin_drop: "a ∉ all_shared ?drop_sb"
by auto
have ?thesis
proof (cases "a ∈ acquired True ?take_sb 𝒪")
case True
from all_shared_acquired_in [OF this a_notin_drop] acquired_append [of True ?take_sb ?drop_sb 𝒪] a_unacq
have False
by auto
thus ?thesis ..
next
case False
with a_unacquired_others i_bound ts_i a_notin_take
have a_unacq': "∀j < length ts.
(let (_,_,_,sb⇩j,_,𝒪,_) = ts!j in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪 ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j ))"
by (auto simp add: Let_def)
from local.weak_sharing_consis_axioms have "weak_sharing_consis ts" .
from read_only_share_all_until_volatile_write_unacquired' [OF dist ro_unowned
‹weak_sharing_consis ts› a_unacq' a_ro]
have a_ro_all: "a ∈ read_only (share_all_until_volatile_write ts 𝒮)" .
from weak_consis weak_sharing_consistent_append [of 𝒪 ?take_sb ?drop_sb]
have weak_consis_drop: "weak_sharing_consistent (acquired True ?take_sb 𝒪) ?drop_sb"
by auto
from weak_sharing_consistent_preserves_distinct_share_all_until_volatile_write [OF dist
ro_unowned ‹weak_sharing_consis ts› i_bound ts_i]
have "acquired True ?take_sb 𝒪 ∩
read_only (share_all_until_volatile_write ts 𝒮) = {}".
from read_only_unacquired_share' [OF this weak_consis_drop a_ro_all a_notin_drop]
acquired_append [of True ?take_sb ?drop_sb 𝒪] a_unacq
show ?thesis by auto
qed
}
ultimately show ?thesis by blast
qed
lemma all_acquired_unshared_acquired:
"⋀𝒪. a ∈ all_acquired sb ==> a ∉ all_shared sb ==> a ∈ acquired True sb 𝒪"
apply (induct sb)
apply (auto split: memref.split intro: all_shared_acquired_in)
done
lemma safe_RMW_common:
assumes safe: "𝒪s,ℛs,i⊢ (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
shows "(a ∈ 𝒪 ∨ a ∈ dom 𝒮) ∧ (∀j < length 𝒪s. i≠j ⟶ (ℛs!j) a ≠ Some False)"
using safe
apply (cases)
apply (auto simp add: domIff)
done
lemma acquired_reads_all_acquired': "⋀𝒪.
acquired_reads True sb 𝒪 ⊆ acquired True sb 𝒪 ∪ all_shared sb"
apply (induct sb)
apply clarsimp
apply (auto split: memref.splits dest: all_shared_acquired_in)
done
lemma release_all_shared_exchange:
"⋀ℛ S' S. ∀a ∈ all_shared sb. (a ∈ S') = (a ∈ S) ⟹ release sb S' ℛ = release sb S ℛ"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
show ?case
proof (cases x)
case (Write⇩s⇩b volatile a' sop v A L R W)
show ?thesis
proof (cases volatile)
case True
note volatile=this
from Cons.hyps [of "(S' ∪ R - L)" "(S ∪ R - L)" Map.empty] Cons.prems
show ?thesis
by (auto simp add: Write⇩s⇩b volatile)
next
case False with Cons Write⇩s⇩b show ?thesis by auto
qed
next
case Read⇩s⇩b with Cons show ?thesis by auto
next
case Prog⇩s⇩b with Cons show ?thesis by auto
next
case (Ghost⇩s⇩b A L R W)
from augment_rels_shared_exchange [of R S S' ℛ] Cons.prems
have "augment_rels S' R ℛ = augment_rels S R ℛ"
by (auto simp add: Ghost⇩s⇩b)
with Cons.hyps [of "(S' ∪ R - L)" "(S ∪ R - L)" "augment_rels S R ℛ"] Cons.prems
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
qed
lemma release_append_Prog⇩s⇩b:
"⋀S ℛ. (release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩1 p⇩2 mis])) S ℛ) =
(release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) S ℛ) "
by (induct sb) (auto split: memref.splits)
subsection ‹Simulation of Store Buffer Machine with History by Virtual Machine with Delayed Releases›
theorem (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_history_step:
assumes step_sb: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b')"
assumes valid_own: "valid_ownership 𝒮⇩s⇩b ts⇩s⇩b"
assumes valid_sb_reads: "valid_reads m⇩s⇩b ts⇩s⇩b"
assumes valid_hist: "valid_history program_step ts⇩s⇩b"
assumes valid_sharing: "valid_sharing 𝒮⇩s⇩b ts⇩s⇩b"
assumes tmps_distinct: "tmps_distinct ts⇩s⇩b"
assumes valid_sops: "valid_sops ts⇩s⇩b"
assumes valid_dd: "valid_data_dependency ts⇩s⇩b"
assumes load_tmps_fresh: "load_tmps_fresh ts⇩s⇩b"
assumes enough_flushs: "enough_flushs ts⇩s⇩b"
assumes valid_program_history: "valid_program_history ts⇩s⇩b"
assumes valid: "valid ts⇩s⇩b"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
shows "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b' ∧ valid_reads m⇩s⇩b' ts⇩s⇩b' ∧ valid_history program_step ts⇩s⇩b' ∧
valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b' ∧ tmps_distinct ts⇩s⇩b' ∧ valid_data_dependency ts⇩s⇩b' ∧
valid_sops ts⇩s⇩b' ∧ load_tmps_fresh ts⇩s⇩b' ∧ enough_flushs ts⇩s⇩b' ∧
valid_program_history ts⇩s⇩b' ∧ valid ts⇩s⇩b' ∧
(∃ts' 𝒮' m'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧
(ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b') ∼ (ts',m',𝒮'))"
proof -
interpret direct_computation:
computation direct_memop_step empty_storebuffer_step program_step "λp p' is sb. sb" .
interpret sbh_computation:
computation sbh_memop_step flush_step program_step
"λp p' is sb. sb @ [Prog⇩s⇩b p p' is]" .
interpret valid_ownership 𝒮⇩s⇩b ts⇩s⇩b by fact
interpret valid_reads m⇩s⇩b ts⇩s⇩b by fact
interpret valid_history program_step ts⇩s⇩b by fact
interpret valid_sharing 𝒮⇩s⇩b ts⇩s⇩b by fact
interpret tmps_distinct ts⇩s⇩b by fact
interpret valid_sops ts⇩s⇩b by fact
interpret valid_data_dependency ts⇩s⇩b by fact
interpret load_tmps_fresh ts⇩s⇩b by fact
interpret enough_flushs ts⇩s⇩b by fact
interpret valid_program_history ts⇩s⇩b by fact
from valid_own valid_sharing
have valid_own_sharing: "valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b"
by (simp add: valid_sharing_def valid_ownership_and_sharing_def)
then
interpret valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b .
from safe_reach_safe_refl [OF safe_reach]
have safe: "safe_delayed (ts,m,𝒮)".
from step_sb
show ?thesis
proof (cases)
case (Memop i p⇩s⇩b "is⇩s⇩b" θ⇩s⇩b sb 𝒟⇩s⇩b 𝒪⇩s⇩b ℛ⇩s⇩b "is⇩s⇩b'" θ⇩s⇩b' sb' 𝒟⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b')
then obtain
ts⇩s⇩b': "ts⇩s⇩b' = ts⇩s⇩b[i := (p⇩s⇩b, is⇩s⇩b',θ⇩s⇩b', sb', 𝒟⇩s⇩b', 𝒪⇩s⇩b',ℛ⇩s⇩b')]" and
i_bound: "i < length ts⇩s⇩b" and
ts⇩s⇩b_i: "ts⇩s⇩b ! i = (p⇩s⇩b, is⇩s⇩b,θ⇩s⇩b,sb, 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)" and
sbh_step: "(is⇩s⇩b, θ⇩s⇩b, sb, m⇩s⇩b, 𝒟⇩s⇩b, 𝒪⇩s⇩b, ℛ⇩s⇩b,𝒮⇩s⇩b) →⇩s⇩b⇩h
(is⇩s⇩b', θ⇩s⇩b', sb', m⇩s⇩b', 𝒟⇩s⇩b', 𝒪⇩s⇩b', ℛ⇩s⇩b', 𝒮⇩s⇩b')"
by auto
from sim obtain
m: "m = flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b" and
𝒮: "𝒮 = share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b" and
leq: "length ts⇩s⇩b = length ts" and
ts_sim: "∀i<length ts⇩s⇩b.
let (p, is⇩s⇩b, θ, sb, 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ) = ts⇩s⇩b ! i;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends ∧
𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts ! i =
(hd_prog p suspends,
is,
θ |` (dom θ - read_tmps suspends), (),
𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b,
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮⇩s⇩b) ℛ)"
by cases blast
from i_bound leq have i_bound': "i < length ts"
by auto
have split_sb: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
(is "sb = ?take_sb@?drop_sb")
by simp
from ts_sim [rule_format, OF i_bound] ts⇩s⇩b_i obtain suspends "is" 𝒟 where
suspends: "suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb" and
is_sim: "instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends" and
𝒟: "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {})" and
ts_i: "ts ! i =
(hd_prog p⇩s⇩b suspends, is,
θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps suspends), (), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (auto simp add: Let_def)
from sbh_step_preserves_valid [OF i_bound ts⇩s⇩b_i sbh_step valid]
have valid': "valid ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
from 𝒟 have 𝒟⇩s⇩b: "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b ?drop_sb ≠ {})"
apply -
apply (case_tac "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
apply (fastforce simp add: outstanding_refs_conv dest: set_dropWhileD)
apply (clarsimp)
apply (drule outstanding_refs_non_empty_dropWhile)
apply blast
done
let ?ts' = "ts[i := (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b, (), 𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b,
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)]"
have i_bound_ts': "i < length ?ts'"
using i_bound'
by auto
hence ts'_i: "?ts'!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b, (),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
from local.sharing_consis_axioms
have sharing_consis_ts⇩s⇩b: "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b" .
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have sharing_consis_sb: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
from sharing_consistent_weak_sharing_consistent [OF this]
have weak_consis_sb: "weak_sharing_consistent 𝒪⇩s⇩b sb".
from this weak_sharing_consistent_append [of 𝒪⇩s⇩b ?take_sb ?drop_sb]
have weak_consis_drop:"weak_sharing_consistent (acquired True ?take_sb 𝒪⇩s⇩b) ?drop_sb"
by auto
from local.ownership_distinct_axioms
have ownership_distinct_ts⇩s⇩b: "ownership_distinct ts⇩s⇩b" .
have steps_flush_sb: "(ts,m,𝒮) ⇒⇩d⇧* (?ts', flush ?drop_sb m, share ?drop_sb 𝒮)"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have reads_consis: "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb".
from reads_consistent_drop_volatile_writes_no_volatile_reads [OF this]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ?drop_sb = {}".
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb".
then have cph: "causal_program_history is⇩s⇩b ?drop_sb"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb"] )
apply (simp)
done
from valid_last_prog [OF i_bound ts⇩s⇩b_i] have last_prog: "last_prog p⇩s⇩b sb = p⇩s⇩b".
then
have lp: "last_prog p⇩s⇩b ?drop_sb = p⇩s⇩b"
apply -
apply (rule last_prog_same_append [where sb="?take_sb"])
apply simp
done
from reads_consistent_flush_all_until_volatile_write [OF valid_own_sharing i_bound
ts⇩s⇩b_i reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb 𝒪⇩s⇩b) m ?drop_sb"
by (simp add: m)
from valid_history [OF i_bound ts⇩s⇩b_i]
have h_consis: "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b (?take_sb@?drop_sb)) (?take_sb@?drop_sb)"
by (simp)
have last_prog_hd_prog: "last_prog (hd_prog p⇩s⇩b sb) ?take_sb = (hd_prog p⇩s⇩b ?drop_sb)"
proof -
from last_prog_hd_prog_append' [OF h_consis] last_prog
have "last_prog (hd_prog p⇩s⇩b ?drop_sb) ?take_sb = hd_prog p⇩s⇩b ?drop_sb"
by (simp)
moreover
have "last_prog (hd_prog p⇩s⇩b (?take_sb @ ?drop_sb)) ?take_sb =
last_prog (hd_prog p⇩s⇩b ?drop_sb) ?take_sb"
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp)
qed
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have "∀sop∈write_sops (?take_sb@?drop_sb). valid_sop sop"
by (simp)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ?drop_sb. valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps (?take_sb@?drop_sb)"
by (simp)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb ∩ read_tmps ?drop_sb = {}" and
distinct_read_tmps_drop: "distinct_read_tmps ?drop_sb"
by (simp only: distinct_read_tmps_append)
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
have hist_consis': "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b ?drop_sb) ?drop_sb"
by (simp add: last_prog_hd_prog)
have rel_eq: "release ?drop_sb (dom 𝒮) (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b) =
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b"
proof -
from release_append [of ?take_sb ?drop_sb]
have "release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b =
release ?drop_sb (dom (share ?take_sb 𝒮⇩s⇩b)) (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
also
have dist: "ownership_distinct ts⇩s⇩b" by fact
have consis: "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b" by fact
have "release ?drop_sb (dom (share ?take_sb 𝒮⇩s⇩b)) (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b) =
release ?drop_sb (dom 𝒮) (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b) "
apply (simp only: 𝒮)
apply (rule release_shared_exchange_weak [rule_format, OF _ weak_consis_drop])
apply (rule share_all_until_volatile_write_thread_local [OF dist consis i_bound ts⇩s⇩b_i, symmetric])
using acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b] all_acquired_append [of ?take_sb ?drop_sb]
by auto
finally
show ?thesis by simp
qed
from flush_store_buffer [OF i_bound' is_sim [simplified suspends]
cph ts_i [simplified suspends] refl lp reads_consis_m hist_consis'
valid_sops_drop distinct_read_tmps_drop no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], of 𝒮]
show ?thesis by (simp add: acquired_take_drop [where pending_write=True, simplified] 𝒟⇩s⇩b rel_eq)
qed
from safe_reach_safe_rtrancl [OF safe_reach steps_flush_sb]
have safe_ts': "safe_delayed (?ts', flush ?drop_sb m, share ?drop_sb 𝒮)".
from safe_delayedE [OF safe_ts' i_bound_ts' ts'_i]
have safe_memop_flush_sb: "map owned ?ts',map released ?ts',i⊢
(is⇩s⇩b, θ⇩s⇩b, flush ?drop_sb m, 𝒟⇩s⇩b,acquired True sb 𝒪⇩s⇩b,
share ?drop_sb 𝒮) √".
from acquired_takeWhile_non_volatile_Write⇩s⇩b
have acquired_take_sb: "acquired True ?take_sb 𝒪⇩s⇩b ⊆ 𝒪⇩s⇩b ∪ all_acquired ?take_sb ".
from sbh_step
show ?thesis
proof (cases)
case (SBHReadBuffered a v volatile t)
then obtain
"is⇩s⇩b": "is⇩s⇩b = Read volatile a t # is⇩s⇩b'" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
𝒟⇩s⇩b': "𝒟⇩s⇩b'=𝒟⇩s⇩b" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b(t↦v)" and
sb': "sb'=sb@[Read⇩s⇩b volatile a t v]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b" and
buf_v: "buffered_val sb a = Some v"
by auto
from safe_memop_flush_sb [simplified is⇩s⇩b]
obtain access_cond': "a ∈ acquired True sb 𝒪⇩s⇩b ∨
a ∈ read_only (share ?drop_sb 𝒮) ∨
(volatile ∧ a ∈ dom (share ?drop_sb 𝒮))" and
volatile_clean: "volatile ⟶ ¬ 𝒟⇩s⇩b" and
rels_cond: "∀j < length ts. i≠j ⟶ released (ts!j) a ≠ Some False" and
rels_nv_cond: "¬volatile ⟶ (∀j < length ts. i≠j ⟶ a ∉ dom (released (ts!j)))"
by cases auto
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i] volatile_clean
have volatile_cond: "volatile ⟶ outstanding_refs is_volatile_Write⇩s⇩b sb ={}"
by auto
from buffered_val_witness [OF buf_v] obtain volatile' sop' A' L' R' W'
where
witness: "Write⇩s⇩b volatile' a sop' v A' L' R' W' ∈ set sb"
by auto
{
fix j p⇩j "is⇩s⇩b⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩s⇩b⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j, 𝒟⇩s⇩b⇩j, 𝒪⇩j,ℛ⇩j)"
assume non_vol: "¬ volatile"
have "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof
assume a_j: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound] jth
obtain suspends⇩j "is⇩j" 𝒟⇩j where
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (auto simp add: Let_def)
from a_j ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have a_notin_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
with acquired_all_acquired [of True sb 𝒪⇩s⇩b]
have a_not_acq: "a ∉ acquired True sb 𝒪⇩s⇩b" by blast
with access_cond' non_vol
have a_ro: "a ∈ read_only (share ?drop_sb 𝒮)"
by auto
from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_notin_sb
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b]
all_acquired_append [of ?take_sb ?drop_sb]
have a_ro_shared: "a ∈ read_only 𝒮"
by auto
from rels_nv_cond [rule_format, OF non_vol j_bound [simplified leq] neq_i_j] ts⇩j
have "a ∉ dom (release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j)"
by auto
with dom_release_takeWhile [of sb⇩j "(dom (𝒮⇩s⇩b))" ℛ⇩j]
obtain
a_rels⇩j: "a ∉ dom ℛ⇩j" and
a_shared⇩j: "a ∉ all_shared ?take_sb⇩j"
by auto
have "a ∉ ⋃((λ(_, _, _, sb, _, _, _). all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) `
set ts⇩s⇩b)"
proof -
{
fix k p⇩k "is⇩k" θ⇩k sb⇩k 𝒟⇩k 𝒪⇩k ℛ⇩k
assume k_bound: "k < length ts⇩s⇩b"
assume ts_k: "ts⇩s⇩b ! k = (p⇩k,is⇩k,θ⇩k,sb⇩k,𝒟⇩k,𝒪⇩k,ℛ⇩k)"
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
have False
proof (cases "k=j")
case True with a_shared⇩j jth ts_k a_in show False by auto
next
case False
from ownership_distinct [OF j_bound k_bound False [symmetric] jth ts_k] a_j
have "a ∉ (𝒪⇩k ∪ all_acquired sb⇩k)" by auto
with all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]] a_in
show False
using all_acquired_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"]
all_shared_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"] by auto
qed
}
thus ?thesis by (fastforce simp add: in_set_conv_nth)
qed
with a_ro_shared
read_only_shared_all_until_volatile_write_subset' [of ts⇩s⇩b 𝒮⇩s⇩b]
have a_ro_shared⇩s⇩b: "a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: 𝒮)
with read_only_unowned [OF j_bound jth]
have a_notin_owns_j: "a ∉ 𝒪⇩j"
by auto
have own_dist: "ownership_distinct ts⇩s⇩b" by fact
have share_consis: "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b" by fact
from sharing_consistent_share_all_until_volatile_write [OF own_dist share_consis i_bound ts⇩s⇩b_i]
have consis': "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪⇩s⇩b) ?drop_sb"
by (simp add: 𝒮)
from share_all_until_volatile_write_thread_local [OF own_dist share_consis j_bound jth a_j] a_ro_shared
have a_ro_take: "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: domIff 𝒮 read_only_def)
from sharing_consis [OF j_bound jth]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
from sharing_consistent_weak_sharing_consistent [OF this] weak_sharing_consistent_append [of 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have weak_consis_drop:"weak_sharing_consistent 𝒪⇩j ?take_sb⇩j"
by auto
from read_only_share_acquired_all_shared [OF this read_only_unowned [OF j_bound jth] a_ro_take ] a_notin_owns_j a_shared⇩j
have "a ∉ all_acquired ?take_sb⇩j"
by auto
with a_j a_notin_owns_j
have a_drop: "a ∈ all_acquired ?drop_sb⇩j"
using all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
by simp
from i_bound j_bound leq have j_bound_ts': "j < length ?ts'"
by auto
note conflict_drop = a_drop [simplified suspends⇩j [symmetric]]
from split_all_acquired_in [OF conflict_drop]
show False
proof
assume "∃sop a' v ys zs A L R W.
(suspends⇩j = ys @ Write⇩s⇩b True a' sop v A L R W# zs) ∧ a ∈ A"
then
obtain a' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from sharing_consis [OF j_bound jth]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound jth]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound jth] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound jth]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound
jth reads_consis_j]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound jth]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound jth]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound jth]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Write⇩s⇩b True a' sop' v' A' L' R' W'# zs)) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(), True, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b] non_vol a_not_acq
have "a ∈ read_only (share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a_A'
show False
by (simp add: share_append in_read_only_convs)
next
assume "∃A L R W ys zs. suspends⇩j = ys @ Ghost⇩s⇩b A L R W # zs ∧ a ∈ A"
then
obtain A' L' R' W' ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from valid_program_history [OF j_bound jth]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound jth] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound jth]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound
jth reads_consis_j]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Ghost⇩s⇩b A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound jth]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Ghost⇩s⇩b A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound jth]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound jth]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Ghost⇩s⇩b A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Ghost⇩s⇩b A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Ghost⇩s⇩b A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) (ys@[Ghost⇩s⇩b A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b (ys @ [Ghost⇩s⇩b A' L' R' W']) ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Ghost⇩s⇩b A' L' R' W']) (flush ?drop_sb m),
share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b,θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b] non_vol a_not_acq
have "a ∈ read_only (share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a_A'
show False
by (simp add: share_append in_read_only_convs)
qed
qed
}
note non_volatile_unowned_others = this
{
assume a_in: "a ∈ read_only (share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
assume nv: "¬ volatile"
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
proof (cases "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb")
case True
from share_all_until_volatile_write_thread_local' [OF ownership_distinct_ts⇩s⇩b
sharing_consis_ts⇩s⇩b i_bound ts⇩s⇩b_i True] True a_in
show ?thesis
by (simp add: 𝒮 read_only_def)
next
case False
from read_only_share_unowned [OF weak_consis_drop _ a_in] False
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b] all_acquired_append [of ?take_sb ?drop_sb]
have a_ro_shared: "a ∈ read_only 𝒮"
by auto
have "a ∉ ⋃((λ(_, _, _, sb, _, _, _).
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts⇩s⇩b)"
proof -
{
fix k p⇩k "is⇩k" θ⇩k sb⇩k 𝒟⇩k 𝒪⇩k ℛ⇩k
assume k_bound: "k < length ts⇩s⇩b"
assume ts_k: "ts⇩s⇩b ! k = (p⇩k,is⇩k,θ⇩k,sb⇩k,𝒟⇩k,𝒪⇩k,ℛ⇩k)"
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
have False
proof (cases "k=i")
case True with False ts⇩s⇩b_i ts_k a_in
all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]]
all_shared_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"] show False by auto
next
case False
from rels_nv_cond [rule_format, OF nv k_bound [simplified leq] False [symmetric] ]
ts_sim [rule_format, OF k_bound] ts_k
have "a ∉ dom (release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k) (dom (𝒮⇩s⇩b)) ℛ⇩k)"
by (auto simp add: Let_def)
with dom_release_takeWhile [of sb⇩k "(dom (𝒮⇩s⇩b))" ℛ⇩k]
obtain
a_rels⇩j: "a ∉ dom ℛ⇩k" and
a_shared⇩j: "a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
by auto
with False a_in show ?thesis
by auto
qed
}
thus ?thesis by (fastforce simp add: in_set_conv_nth)
qed
with read_only_shared_all_until_volatile_write_subset' [of ts⇩s⇩b 𝒮⇩s⇩b] a_ro_shared
have "a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: 𝒮)
from read_only_share_unowned' [OF weak_consis_sb read_only_unowned [OF i_bound ts⇩s⇩b_i] False this]
show ?thesis .
qed
} note non_vol_ro_reduction = this
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (cases volatile)
case False
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Read⇩s⇩b False a t v])"
using access_cond' False non_vol_ro_reduction
by (auto simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (auto simp add: False ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
case True
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Read⇩s⇩b True a t v])"
using True
by (simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (auto simp add: True ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
have out: "outstanding_refs is_volatile_Write⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v]) ⊆
outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: outstanding_refs_append)
have "all_acquired (sb @ [Read⇩s⇩b volatile a t v]) ⊆ all_acquired sb"
by (auto simp add: all_acquired_append)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i out this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof (cases volatile)
case True
have r: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t v])) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t v]))
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (simp_all add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append True)
done
have "𝒪⇩s⇩b ∪ all_acquired (sb @ [Read⇩s⇩b volatile a t v]) ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (simp add: all_acquired_append)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i r this]
show ?thesis
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb')
next
case False
show ?thesis
proof (unfold_locales)
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n, ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m, ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
have acq_eq: "(𝒪⇩s⇩b' ∪ all_acquired sb') = (𝒪⇩s⇩b ∪ all_acquired sb)"
by (simp add: all_acquired_append sb' 𝒪⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n, ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
moreover
note acq_eq
ultimately show ?thesis
using True ts⇩s⇩b_i nth mth n_bound' m_bound'
by (simp add: ts⇩s⇩b')
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] ts⇩s⇩b_i mth']
moreover
note acq_eq
moreover
note non_volatile_unowned_others [OF m_bound' neq_m_i [symmetric] mth']
ultimately show ?thesis
using True ts⇩s⇩b_i nth mth n_bound' m_bound' neq_m_i
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append ts⇩s⇩b' sb' 𝒪⇩s⇩b')+
done
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n, ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have "all_acquired (sb @ [Read⇩s⇩b volatile a t v]) ⊆ all_acquired sb"
by (auto simp add: all_acquired_append)
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have hcons: "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have t_notin_reads: "t ∉ read_tmps sb"
by (auto simp add: "is⇩s⇩b")
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have t_notin_writes: "t ∉ ⋃(fst ` write_sops sb)"
by (auto simp add: "is⇩s⇩b")
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_sops: "∀sop ∈ write_sops sb. valid_sop sop"
by auto
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have t_fresh: "t ∉ dom θ⇩s⇩b"
using "is⇩s⇩b"
by simp
have "history_consistent (θ⇩s⇩b(t↦v))
(hd_prog p⇩s⇩b (sb@ [Read⇩s⇩b volatile a t v])) (sb@ [Read⇩s⇩b volatile a t v])"
using t_notin_writes valid_sops t_fresh hcons
valid_implies_valid_prog_hd [OF i_bound ts⇩s⇩b_i valid]
apply -
apply (rule history_consistent_appendI)
apply (auto simp add: hd_prog_append_Read⇩s⇩b)
done
from valid_history_nth_update [OF i_bound this]
show ?thesis
by (auto simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
from reads_consistent_buffered_snoc [OF buf_v valid_reads [OF i_bound ts⇩s⇩b_i]
volatile_cond]
have reads_consis': "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v])"
by (simp split: if_split_asm)
from valid_reads_nth_update [OF i_bound this]
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v])"
by (simp add: sharing_consistent_append)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' 𝒮⇩s⇩b')
next
note read_only_unowned [OF i_bound ts⇩s⇩b_i]
from read_only_unowned_nth_update [OF i_bound this]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'" by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b sb".
hence "no_write_to_read_only_memory 𝒮⇩s⇩b (sb@[Read⇩s⇩b volatile a t v])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b' sb')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto split: instr.splits simp add: is⇩s⇩b)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps sb".
moreover
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "t ∉ read_tmps sb"
by (auto simp add: is⇩s⇩b)
ultimately have "distinct_read_tmps (sb @ [Read⇩s⇩b volatile a t v])"
by (auto simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps (sb @ [Read⇩s⇩b volatile a t v]) = {}"
by (clarsimp simp add: read_tmps_append "is⇩s⇩b")
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
have valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b")
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_write_sops': "∀sop∈write_sops (sb@ [Read⇩s⇩b volatile a t v]). valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound valid_write_sops' valid_store_sops']
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops (sb@ [Read⇩s⇩b volatile a t v])) = {}"
by (auto simp add: write_sops_append "is⇩s⇩b")
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps (Read volatile a t # is⇩s⇩b') ∩ dom θ⇩s⇩b = {}"
by (simp add: "is⇩s⇩b")
moreover
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i] have "t ∉ load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b")
ultimately have "load_tmps is⇩s⇩b' ∩ dom (θ⇩s⇩b(t ↦ v)) = {}"
by auto
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t v]) = {}"
by (auto simp add: outstanding_refs_append )
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb' 𝒟⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b' (sb@[Read⇩s⇩b volatile a t v])"
by (auto simp: causal_program_history_Read "is⇩s⇩b")
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b (sb @ [Read⇩s⇩b volatile a t v]) = p⇩s⇩b"
by (simp add: last_prog_append_Read⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv )
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is = Read volatile a t # is⇩s⇩b'"
by (simp add: "is⇩s⇩b")
with suspends_empty ts_i
have ts_i: "ts!i = (p⇩s⇩b, Read volatile a t # is⇩s⇩b', θ⇩s⇩b,(), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
from direct_memop_step.Read
have "(Read volatile a t # is⇩s⇩b', θ⇩s⇩b, (), m, 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b', θ⇩s⇩b(t ↦ m a), (), m, 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, 𝒮)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d (ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ m a), (),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)], m, 𝒮)" .
moreover
from flush_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified "is⇩s⇩b"] ]
have flush_commute: "flush_all_until_volatile_write
(ts⇩s⇩b[i := (p⇩s⇩b,is⇩s⇩b',
θ⇩s⇩b(t↦v), sb @ [Read⇩s⇩b volatile a t v], 𝒟⇩s⇩b, 𝒪⇩s⇩b, ℛ⇩s⇩b)]) m⇩s⇩b =
flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b".
from True witness have not_volatile': "volatile' = False"
by (auto simp add: outstanding_refs_conv)
from witness not_volatile' have a_out_sb: "a ∈ outstanding_refs (Not ∘ is_volatile) sb"
apply (cases sop')
apply (fastforce simp add: outstanding_refs_conv is_volatile_def split: memref.splits)
done
with non_volatile_owned_or_read_only_outstanding_refs
[OF outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]]
have a_owned: "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb ∪ read_only_reads 𝒪⇩s⇩b sb"
by auto
have "flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b a = v"
proof -
have "∀j < length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b ?take_sb⇩j"
with outstanding_refs_takeWhile [where P'= "Not ∘ is_volatile_Write⇩s⇩b"]
have a_in': "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
have j_owns: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have a_not_owns: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by blast
from non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by simp
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF this] a_in
have j_owns_drop: "a ∈ 𝒪⇩j ∪ all_acquired ?take_sb⇩j"
by auto
from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
have no_unsharing:"release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j a ≠ Some False"
by (auto simp add: Let_def)
{
assume "a ∈ acquired True sb 𝒪⇩s⇩b"
with acquired_all_acquired_in [OF this] ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
j_owns
have False
by auto
}
moreover
{
assume a_ro: "a ∈ read_only (share ?drop_sb 𝒮)"
from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_not_owns
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b]
all_acquired_append [of ?take_sb ?drop_sb]
have "a ∈ read_only 𝒮"
by auto
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: read_only_def 𝒮)
hence a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: read_only_def domIff)
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
non_volatile_writes_unshared_append [of 𝒮⇩s⇩b ?take_sb⇩j ?drop_sb⇩j]
have nvw: "non_volatile_writes_unshared 𝒮⇩s⇩b ?take_sb⇩j" by auto
from release_not_unshared_no_write_take [OF this no_unsharing a_dom] a_in
have False by auto
}
moreover
{
assume a_share: "volatile ∧ a ∈ dom (share ?drop_sb 𝒮)"
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
with non_volatile_writes_unshared_append [of 𝒮⇩s⇩b "?take_sb⇩j"
"?drop_sb⇩j"]
have unshared_take: "non_volatile_writes_unshared 𝒮⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by clarsimp
from valid_own have own_dist: "ownership_distinct ts⇩s⇩b"
by (simp add: valid_ownership_def)
from valid_sharing have "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b"
by (simp add: valid_sharing_def)
from sharing_consistent_share_all_until_volatile_write [OF own_dist this i_bound ts⇩s⇩b_i]
have sc: "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪⇩s⇩b) ?drop_sb"
by (simp add: 𝒮)
from sharing_consistent_share_all_shared
have "dom (share ?drop_sb 𝒮) ⊆ dom 𝒮 ∪ all_shared ?drop_sb"
by auto
also from sharing_consistent_all_shared [OF sc]
have "… ⊆ dom 𝒮 ∪ acquired True ?take_sb 𝒪⇩s⇩b" by auto
also from acquired_all_acquired all_acquired_takeWhile
have "… ⊆ dom 𝒮 ∪ (𝒪⇩s⇩b ∪ all_acquired sb)" by force
finally
have a_shared: "a ∈ dom 𝒮"
using a_share a_not_owns
by auto
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: 𝒮 domIff)
from release_not_unshared_no_write_take [OF unshared_take no_unsharing a_dom] a_in
have False by auto
}
ultimately show False
using access_cond'
by auto
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from flush_all_until_volatile_write_buffered_val_conv
[OF True i_bound ts⇩s⇩b_i this]
show ?thesis
by (simp add: buf_v)
qed
hence m_a_v: "m a = v"
by (simp add: m)
have tmps_commute: "θ⇩s⇩b(t ↦ v) = (θ⇩s⇩b |` (dom θ⇩s⇩b - {t}))(t ↦ v)"
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
from suspend_nothing
have suspend_nothing': "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = []"
by (simp add: sb')
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t v]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts[i := (p⇩s⇩b,is⇩s⇩b',
θ⇩s⇩b(t↦m a),(),𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)],m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' ℛ⇩s⇩b')
using share_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' θ⇩s⇩b' ℛ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i True 𝒟'
apply (clarsimp simp add: Let_def nth_list_update
outstanding_refs_conv m_a_v ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' sb' ℛ⇩s⇩b' suspend_nothing'
𝒟⇩s⇩b' flush_all acquired_append release_append
split: if_split_asm )
apply (rule tmps_commute)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_sops' valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid'
m⇩s⇩b' 𝒮⇩s⇩b' 𝒪⇩s⇩b'
by (auto simp del: fun_upd_apply )
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' sop' A' L' R' W' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
apply (auto)
subgoal for y ys
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends: "suspends = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
from flush_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i
[simplified "is⇩s⇩b"] ]
have flush_commute: "flush_all_until_volatile_write
(ts⇩s⇩b[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b(t ↦ v), sb @ [Read⇩s⇩b volatile a t v], 𝒟⇩s⇩b, 𝒪⇩s⇩b, ℛ⇩s⇩b)]) m⇩s⇩b =
flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b".
have "Write⇩s⇩b True a' sop' v' A' L' R' W'∈ set sb"
by (subst sb_split) auto
from dropWhile_append1 [OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)"]
have drop_app_comm:
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t v])) =
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ [Read⇩s⇩b volatile a t v]"
by simp
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "t ∉ dom θ⇩s⇩b"
by (auto simp add: "is⇩s⇩b")
then have tmps_commute:
"θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps sb'') =
θ⇩s⇩b |` (dom θ⇩s⇩b - insert t (read_tmps sb''))"
apply -
apply (rule ext)
apply auto
done
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t v]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' )
using share_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app_comm
read_tmps_append suspends prog_instrs_append_Read⇩s⇩b instrs_append_Read⇩s⇩b
hd_prog_append_Read⇩s⇩b
drop "is⇩s⇩b" ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' acquired_append takeWhile_append1 [OF r_in] volatile_r
split: if_split_asm)
apply (simp add: drop tmps_commute)+
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
qed
next
case (SBHReadUnbuffered a volatile t)
then obtain
"is⇩s⇩b": "is⇩s⇩b = Read volatile a t # is⇩s⇩b'" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b(t↦(m⇩s⇩b a))" and
sb': "sb'=sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
𝒟⇩s⇩b': "𝒟⇩s⇩b'=𝒟⇩s⇩b" and
buf_None: "buffered_val sb a = None"
by auto
from safe_memop_flush_sb [simplified is⇩s⇩b]
obtain access_cond': "a ∈ acquired True sb 𝒪⇩s⇩b ∨
a ∈ read_only (share ?drop_sb 𝒮) ∨ (volatile ∧ a ∈ dom (share ?drop_sb 𝒮))" and
volatile_clean: "volatile ⟶ ¬ 𝒟⇩s⇩b" and
rels_cond: "∀j < length ts. i≠j ⟶ released (ts!j) a ≠ Some False" and
rels_nv_cond: "¬volatile ⟶ (∀j < length ts. i≠j ⟶ a ∉ dom (released (ts!j)))"
by cases auto
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i] volatile_clean
have volatile_cond: "volatile ⟶ outstanding_refs is_volatile_Write⇩s⇩b sb ={}"
by auto
{
fix j p⇩j "is⇩s⇩b⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩s⇩b⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j, 𝒟⇩s⇩b⇩j, 𝒪⇩j,ℛ⇩j)"
assume non_vol: "¬ volatile"
have "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof
assume a_j: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound] jth
obtain suspends⇩j "is⇩j" 𝒟⇩j where
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (auto simp add: Let_def)
from a_j ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have a_notin_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
with acquired_all_acquired [of True sb 𝒪⇩s⇩b]
have a_not_acq: "a ∉ acquired True sb 𝒪⇩s⇩b" by blast
with access_cond' non_vol
have a_ro: "a ∈ read_only (share ?drop_sb 𝒮)"
by auto
from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_notin_sb
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b]
all_acquired_append [of ?take_sb ?drop_sb]
have a_ro_shared: "a ∈ read_only 𝒮"
by auto
from rels_nv_cond [rule_format, OF non_vol j_bound [simplified leq] neq_i_j] ts⇩j
have "a ∉ dom (release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j)"
by auto
with dom_release_takeWhile [of sb⇩j "(dom (𝒮⇩s⇩b))" ℛ⇩j]
obtain
a_rels⇩j: "a ∉ dom ℛ⇩j" and
a_shared⇩j: "a ∉ all_shared ?take_sb⇩j"
by auto
have "a ∉ ⋃((λ(_, _, _, sb, _, _, _). all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) `
set ts⇩s⇩b)"
proof -
{
fix k p⇩k "is⇩k" θ⇩k sb⇩k 𝒟⇩k 𝒪⇩k ℛ⇩k
assume k_bound: "k < length ts⇩s⇩b"
assume ts_k: "ts⇩s⇩b ! k = (p⇩k,is⇩k,θ⇩k,sb⇩k,𝒟⇩k,𝒪⇩k,ℛ⇩k)"
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
have False
proof (cases "k=j")
case True with a_shared⇩j jth ts_k a_in show False by auto
next
case False
from ownership_distinct [OF j_bound k_bound False [symmetric] jth ts_k] a_j
have "a ∉ (𝒪⇩k ∪ all_acquired sb⇩k)" by auto
with all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]] a_in
show False
using all_acquired_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"]
all_shared_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"] by auto
qed
}
thus ?thesis by (fastforce simp add: in_set_conv_nth)
qed
with a_ro_shared
read_only_shared_all_until_volatile_write_subset' [of ts⇩s⇩b 𝒮⇩s⇩b]
have a_ro_shared⇩s⇩b: "a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: 𝒮)
with read_only_unowned [OF j_bound jth]
have a_notin_owns_j: "a ∉ 𝒪⇩j"
by auto
have own_dist: "ownership_distinct ts⇩s⇩b" by fact
have share_consis: "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b" by fact
from sharing_consistent_share_all_until_volatile_write [OF own_dist share_consis i_bound ts⇩s⇩b_i]
have consis': "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪⇩s⇩b) ?drop_sb"
by (simp add: 𝒮)
from share_all_until_volatile_write_thread_local [OF own_dist share_consis j_bound jth a_j] a_ro_shared
have a_ro_take: "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: domIff 𝒮 read_only_def)
from sharing_consis [OF j_bound jth]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
from sharing_consistent_weak_sharing_consistent [OF this] weak_sharing_consistent_append [of 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have weak_consis_drop:"weak_sharing_consistent 𝒪⇩j ?take_sb⇩j"
by auto
from read_only_share_acquired_all_shared [OF this read_only_unowned [OF j_bound jth] a_ro_take ] a_notin_owns_j a_shared⇩j
have "a ∉ all_acquired ?take_sb⇩j"
by auto
with a_j a_notin_owns_j
have a_drop: "a ∈ all_acquired ?drop_sb⇩j"
using all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
by simp
from i_bound j_bound leq have j_bound_ts': "j < length ?ts'"
by auto
note conflict_drop = a_drop [simplified suspends⇩j [symmetric]]
from split_all_acquired_in [OF conflict_drop]
show False
proof
assume "∃sop a' v ys zs A L R W.
(suspends⇩j = ys @ Write⇩s⇩b True a' sop v A L R W# zs) ∧ a ∈ A"
then
obtain a' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from sharing_consis [OF j_bound jth]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound jth]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound jth] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound jth]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound
jth reads_consis_j]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound jth]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound jth]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound jth]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Write⇩s⇩b True a' sop' v' A' L' R' W'# zs)) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(), True, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b] non_vol a_not_acq
have "a ∈ read_only (share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a_A'
show False
by (simp add: share_append in_read_only_convs)
next
assume "∃A L R W ys zs. suspends⇩j = ys @ Ghost⇩s⇩b A L R W # zs ∧ a ∈ A"
then
obtain A' L' R' W' ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from valid_program_history [OF j_bound jth]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound jth] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound jth]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound
jth reads_consis_j]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Ghost⇩s⇩b A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound jth]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Ghost⇩s⇩b A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound jth]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound jth]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Ghost⇩s⇩b A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Ghost⇩s⇩b A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Ghost⇩s⇩b A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) (ys@[Ghost⇩s⇩b A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b (ys @ [Ghost⇩s⇩b A' L' R' W']) ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Ghost⇩s⇩b A' L' R' W']) (flush ?drop_sb m),
share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b,θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b] non_vol a_not_acq
have "a ∈ read_only (share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a_A'
show False
by (simp add: share_append in_read_only_convs)
qed
qed
}
note non_volatile_unowned_others = this
{
assume a_in: "a ∈ read_only (share (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒮)"
assume nv: "¬ volatile"
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
proof (cases "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb")
case True
from share_all_until_volatile_write_thread_local' [OF ownership_distinct_ts⇩s⇩b
sharing_consis_ts⇩s⇩b i_bound ts⇩s⇩b_i True] True a_in
show ?thesis
by (simp add: 𝒮 read_only_def)
next
case False
from read_only_share_unowned [OF weak_consis_drop _ a_in] False
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b] all_acquired_append [of ?take_sb ?drop_sb]
have a_ro_shared: "a ∈ read_only 𝒮"
by auto
have "a ∉ ⋃((λ(_, _, _, sb, _, _, _).
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ` set ts⇩s⇩b)"
proof -
{
fix k p⇩k "is⇩k" θ⇩k sb⇩k 𝒟⇩k 𝒪⇩k ℛ⇩k
assume k_bound: "k < length ts⇩s⇩b"
assume ts_k: "ts⇩s⇩b ! k = (p⇩k,is⇩k,θ⇩k,sb⇩k,𝒟⇩k,𝒪⇩k,ℛ⇩k)"
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
have False
proof (cases "k=i")
case True with False ts⇩s⇩b_i ts_k a_in
all_shared_acquired_or_owned [OF sharing_consis [OF k_bound ts_k]]
all_shared_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k"] show False by auto
next
case False
from rels_nv_cond [rule_format, OF nv k_bound [simplified leq] False [symmetric] ]
ts_sim [rule_format, OF k_bound] ts_k
have "a ∉ dom (release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k) (dom (𝒮⇩s⇩b)) ℛ⇩k)"
by (auto simp add: Let_def)
with dom_release_takeWhile [of sb⇩k "(dom (𝒮⇩s⇩b))" ℛ⇩k]
obtain
a_rels⇩j: "a ∉ dom ℛ⇩k" and
a_shared⇩j: "a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩k)"
by auto
with False a_in show ?thesis
by auto
qed
}
thus ?thesis
by (auto simp add: in_set_conv_nth)
qed
with read_only_shared_all_until_volatile_write_subset' [of ts⇩s⇩b 𝒮⇩s⇩b] a_ro_shared
have "a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: 𝒮)
from read_only_share_unowned' [OF weak_consis_sb read_only_unowned [OF i_bound ts⇩s⇩b_i] False this]
show ?thesis .
qed
} note non_vol_ro_reduction = this
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (cases volatile)
case False
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Read⇩s⇩b False a t (m⇩s⇩b a)])"
using access_cond' False non_vol_ro_reduction
by (auto simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (auto simp add: False ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
case True
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Read⇩s⇩b True a t (m⇩s⇩b a)])"
using True
by (simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (auto simp add: True ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
have out: "outstanding_refs is_volatile_Write⇩s⇩b (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ⊆
outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: outstanding_refs_append)
have "all_acquired (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ⊆ all_acquired sb"
by (auto simp add: all_acquired_append)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i out this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof (cases volatile)
case True
have r: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b)
(sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]))
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (simp_all add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append True)
done
have "𝒪⇩s⇩b ∪ all_acquired (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (simp add: all_acquired_append)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i r this]
show ?thesis
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb')
next
case False
show ?thesis
proof (unfold_locales)
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
have acq_eq: "(𝒪⇩s⇩b' ∪ all_acquired sb') = (𝒪⇩s⇩b ∪ all_acquired sb)"
by (simp add: all_acquired_append sb' 𝒪⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
moreover
note acq_eq
ultimately show ?thesis
using True ts⇩s⇩b_i nth mth n_bound' m_bound'
by (simp add: ts⇩s⇩b')
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] ts⇩s⇩b_i mth']
moreover
note acq_eq
moreover
note non_volatile_unowned_others [OF m_bound' neq_m_i [symmetric] mth']
ultimately show ?thesis
using True ts⇩s⇩b_i nth mth n_bound' m_bound' neq_m_i
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append ts⇩s⇩b' sb' 𝒪⇩s⇩b')+
done
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
qed
show "ownership_distinct ts⇩s⇩b'"
proof -
have "all_acquired (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ⊆ all_acquired sb"
by (auto simp add: all_acquired_append)
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have hcons: "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have t_notin_reads: "t ∉ read_tmps sb"
by (auto simp add: "is⇩s⇩b")
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have t_notin_writes: "t ∉ ⋃(fst ` write_sops sb )"
by (auto simp add: "is⇩s⇩b")
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_sops: "∀sop ∈ write_sops sb. valid_sop sop"
by auto
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have t_fresh: "t ∉ dom θ⇩s⇩b"
using "is⇩s⇩b"
by simp
from valid_implies_valid_prog_hd [OF i_bound ts⇩s⇩b_i valid]
have "history_consistent (θ⇩s⇩b(t↦m⇩s⇩b a))
(hd_prog p⇩s⇩b (sb@ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]))
(sb@ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
using t_notin_writes valid_sops t_fresh hcons
apply -
apply (rule history_consistent_appendI)
apply (auto simp add: hd_prog_append_Read⇩s⇩b)
done
from valid_history_nth_update [OF i_bound this]
show ?thesis
by (auto simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
from
reads_consistent_unbuffered_snoc [OF buf_None refl valid_reads [OF i_bound ts⇩s⇩b_i] volatile_cond ]
have reads_consis': "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (simp split: if_split_asm)
from valid_reads_nth_update [OF i_bound this]
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (simp add: sharing_consistent_append)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' 𝒮⇩s⇩b')
next
note read_only_unowned [OF i_bound ts⇩s⇩b_i]
from read_only_unowned_nth_update [OF i_bound this]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'" by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b sb".
hence "no_write_to_read_only_memory 𝒮⇩s⇩b (sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b' sb')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto split: instr.splits simp add: is⇩s⇩b)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps sb".
moreover
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "t ∉ read_tmps sb"
by (auto simp add: is⇩s⇩b)
ultimately have "distinct_read_tmps (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (auto simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) = {}"
by (clarsimp simp add: read_tmps_append "is⇩s⇩b")
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
have valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b")
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_write_sops': "∀sop∈write_sops (sb@ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]).
valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound valid_write_sops' valid_store_sops']
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops (sb@ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])) = {}"
by (auto simp add: write_sops_append "is⇩s⇩b")
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps (Read volatile a t # is⇩s⇩b') ∩ dom θ⇩s⇩b = {}"
by (simp add: "is⇩s⇩b")
moreover
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i] have "t ∉ load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b")
ultimately have "load_tmps is⇩s⇩b' ∩ dom (θ⇩s⇩b(t ↦ (m⇩s⇩b a))) = {}"
by auto
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)]) = {}"
by (auto simp add: outstanding_refs_append )
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb' 𝒟⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b' (sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)])"
by (auto simp: causal_program_history_Read "is⇩s⇩b")
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]) = p⇩s⇩b"
by (simp add: last_prog_append_Read⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv )
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is = Read volatile a t # is⇩s⇩b'"
by (simp add: "is⇩s⇩b")
with suspends_empty ts_i
have ts_i: "ts!i = (p⇩s⇩b, Read volatile a t # is⇩s⇩b', θ⇩s⇩b,(),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
from direct_memop_step.Read
have "(Read volatile a t # is⇩s⇩b',θ⇩s⇩b, (), m,
𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,𝒮) →
(is⇩s⇩b', θ⇩s⇩b(t ↦ m a), (), m, 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, 𝒮)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d (ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ m a), (),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)], m, 𝒮)".
moreover
from flush_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified "is⇩s⇩b"] ]
have flush_commute: "flush_all_until_volatile_write
(ts⇩s⇩b[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b(t↦m⇩s⇩b a), sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)], 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)])
m⇩s⇩b =
flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b".
have "flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b a = m⇩s⇩b a"
proof -
have "∀j < length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b ?take_sb⇩j"
with outstanding_refs_takeWhile [where P'= "Not ∘ is_volatile_Write⇩s⇩b"]
have a_in': "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
have j_owns: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have a_not_owns: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by blast
from non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by simp
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF this] a_in
have j_owns_drop: "a ∈ 𝒪⇩j ∪ all_acquired ?take_sb⇩j"
by auto
from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
have no_unsharing:"release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j a ≠ Some False"
by (auto simp add: Let_def)
{
assume "a ∈ acquired True sb 𝒪⇩s⇩b"
with acquired_all_acquired_in [OF this] ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
j_owns
have False
by auto
}
moreover
{
assume a_ro: "a ∈ read_only (share ?drop_sb 𝒮)"
from read_only_share_unowned_in [OF weak_consis_drop a_ro] a_not_owns
acquired_all_acquired [of True ?take_sb 𝒪⇩s⇩b]
all_acquired_append [of ?take_sb ?drop_sb]
have "a ∈ read_only 𝒮"
by auto
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: read_only_def 𝒮)
hence a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: read_only_def domIff)
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
non_volatile_writes_unshared_append [of 𝒮⇩s⇩b ?take_sb⇩j ?drop_sb⇩j]
have nvw: "non_volatile_writes_unshared 𝒮⇩s⇩b ?take_sb⇩j" by auto
from release_not_unshared_no_write_take [OF this no_unsharing a_dom] a_in
have False by auto
}
moreover
{
assume a_share: "volatile ∧ a ∈ dom (share ?drop_sb 𝒮)"
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
with non_volatile_writes_unshared_append [of 𝒮⇩s⇩b "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have unshared_take: "non_volatile_writes_unshared 𝒮⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by clarsimp
from valid_own have own_dist: "ownership_distinct ts⇩s⇩b"
by (simp add: valid_ownership_def)
from valid_sharing have "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b"
by (simp add: valid_sharing_def)
from sharing_consistent_share_all_until_volatile_write [OF own_dist this i_bound ts⇩s⇩b_i]
have sc: "sharing_consistent 𝒮 (acquired True ?take_sb 𝒪⇩s⇩b) ?drop_sb"
by (simp add: 𝒮)
from sharing_consistent_share_all_shared
have "dom (share ?drop_sb 𝒮) ⊆ dom 𝒮 ∪ all_shared ?drop_sb"
by auto
also from sharing_consistent_all_shared [OF sc]
have "… ⊆ dom 𝒮 ∪ acquired True ?take_sb 𝒪⇩s⇩b" by auto
also from acquired_all_acquired all_acquired_takeWhile
have "… ⊆ dom 𝒮 ∪ (𝒪⇩s⇩b ∪ all_acquired sb)" by force
finally
have a_shared: "a ∈ dom 𝒮"
using a_share a_not_owns
by auto
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: 𝒮 domIff)
from release_not_unshared_no_write_take [OF unshared_take no_unsharing a_dom] a_in
have False by auto
}
ultimately show False
using access_cond'
by auto
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from flush_all_until_volatile_write_buffered_val_conv
[OF True i_bound ts⇩s⇩b_i this]
show ?thesis
by (simp add: buf_None)
qed
hence m_a: "m a = m⇩s⇩b a"
by (simp add: m)
have tmps_commute: "θ⇩s⇩b(t ↦ (m⇩s⇩b a)) =
(θ⇩s⇩b |` (dom θ⇩s⇩b - {t}))(t ↦ (m⇩s⇩b a))"
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
from suspend_nothing
have suspend_nothing': "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = []"
by (simp add: sb')
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b(t↦m a),(), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)], m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' )
using share_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i True 𝒟'
apply (clarsimp simp add: Let_def nth_list_update
outstanding_refs_conv m_a ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' suspend_nothing'
flush_all acquired_append release_append
split: if_split_asm )
apply (rule tmps_commute)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_sops' valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid'
m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' sop' A' L' R' W' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
apply (auto)
subgoal for y ys
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends: "suspends = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
note flush_commute = flush_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i
[simplified "is⇩s⇩b"] ]
have "Write⇩s⇩b True a' sop' v' A' L' R' W'∈ set sb"
by (subst sb_split) auto
from dropWhile_append1 [OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)"]
have drop_app_comm:
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)])) =
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ [Read⇩s⇩b volatile a t (m⇩s⇩b a)]"
by simp
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "t ∉ dom θ⇩s⇩b"
by (auto simp add: "is⇩s⇩b")
then have tmps_commute:
"θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps sb'') =
θ⇩s⇩b |` (dom θ⇩s⇩b - insert t (read_tmps sb''))"
apply -
apply (rule ext)
apply auto
done
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Read⇩s⇩b volatile a t (m⇩s⇩b a)]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb')
using share_all_until_volatile_write_Read_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app_comm
read_tmps_append suspends prog_instrs_append_Read⇩s⇩b instrs_append_Read⇩s⇩b
hd_prog_append_Read⇩s⇩b
drop "is⇩s⇩b" ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' acquired_append takeWhile_append1 [OF r_in] volatile_r split: if_split_asm)
apply (simp add: drop tmps_commute)+
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid'
m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
qed
next
case (SBHWriteNonVolatile a D f A L R W)
then obtain
"is⇩s⇩b": "is⇩s⇩b = Write False a (D, f) A L R W# is⇩s⇩b'" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b" and
𝒟⇩s⇩b': "𝒟⇩s⇩b'=𝒟⇩s⇩b" and
sb': "sb'=sb@[Write⇩s⇩b False a (D, f) (f θ⇩s⇩b) A L R W]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b"
by auto
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have D_tmps: "D ⊆ dom θ⇩s⇩b"
by (simp add: is⇩s⇩b)
from safe_memop_flush_sb [simplified is⇩s⇩b]
obtain a_owned': "a ∈ acquired True sb 𝒪⇩s⇩b" and a_unshared': "a ∉ dom (share ?drop_sb 𝒮)" and
rels_cond: "∀j < length ts. i≠j ⟶ a ∉ dom (released (ts!j))"
by cases auto
from a_owned' acquired_all_acquired
have a_owned'': "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
{
fix j
fix p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i ≠ j"
have "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof -
from ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j] a_owned''
show ?thesis
by auto
qed
} note a_unowned_others = this
have a_unshared: "a ∉ dom (share sb 𝒮⇩s⇩b)"
proof
assume a_share: "a ∈ dom (share sb 𝒮⇩s⇩b)"
from valid_sharing have "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b"
by (simp add: valid_sharing_def)
from in_shared_sb_share_all_until_volatile_write [OF this i_bound ts⇩s⇩b_i a_owned'' a_share]
have "a ∈ dom (share ?drop_sb 𝒮)"
by (simp add: 𝒮)
with a_unshared'
show False
by auto
qed
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
with a_owned'
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
have "outstanding_refs is_volatile_Write⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) ⊆
outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: outstanding_refs_append)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' all_acquired_append)
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof -
have r: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b)
(sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]))
⊆
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (simp_all add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append )
done
have "𝒪⇩s⇩b ∪ all_acquired (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (simp add: all_acquired_append)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i r this]
show ?thesis
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb')
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show ?thesis by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' all_acquired_append)
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
with valid_write_sops [OF i_bound ts⇩s⇩b_i] D_tmps
valid_implies_valid_prog_hd [OF i_bound ts⇩s⇩b_i valid]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b (sb@[Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]))
(sb@ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
apply -
apply (rule history_consistent_appendI)
apply (auto simp add: hd_prog_append_Write⇩s⇩b)
done
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
from reads_consistent_snoc_Write⇩s⇩b [OF this]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])".
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i] a_unshared
have "non_volatile_writes_unshared 𝒮⇩s⇩b
(sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
then
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: sharing_consistent_append)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b' 𝒮⇩s⇩b')
next
from a_unshared
have "a ∉ read_only (share sb 𝒮⇩s⇩b)"
by (auto simp add: read_only_def dom_def)
with no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto split: instr.splits simp add: "is⇩s⇩b")
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps sb".
hence "distinct_read_tmps (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) = {}"
by (clarsimp simp add: read_tmps_append "is⇩s⇩b")
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain valid_Df: "valid_sop (D,f)" and
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b")
from valid_Df valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_write_sops': "∀sop∈write_sops (sb@ [Write⇩s⇩b False a (D, f) (f θ⇩s⇩b) A L R W]).
valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound valid_write_sops' valid_store_sops']
show ?thesis
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain D_indep: "D ∩ load_tmps is⇩s⇩b' = {}" and
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i] D_indep
have "load_tmps is⇩s⇩b' ∩
⋃(fst ` write_sops (sb@ [Write⇩s⇩b False a (D, f) (f θ⇩s⇩b) A L R W])) = {}"
by (auto simp add: write_sops_append "is⇩s⇩b")
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ dom θ⇩s⇩b = {}"
by (auto simp add: "is⇩s⇩b")
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' "is⇩s⇩b" sb' 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) = {}"
by (auto simp add: outstanding_refs_append )
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb' 𝒟⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b' (sb@[Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W])"
by (auto simp: causal_program_history_Write "is⇩s⇩b")
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b (sb @ [Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) = p⇩s⇩b"
by (simp add: last_prog_append_Write⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
from valid_store_sops [OF i_bound ts⇩s⇩b_i, rule_format]
have "valid_sop (D,f)" by (auto simp add: "is⇩s⇩b")
then interpret valid_sop "(D,f)" .
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is = Write False a (D,f) A L R W# is⇩s⇩b'"
by (simp add: "is⇩s⇩b")
with suspends_empty ts_i
have ts_i: "ts!i = (p⇩s⇩b, Write False a (D,f) A L R W# is⇩s⇩b',
θ⇩s⇩b,(),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom (𝒮⇩s⇩b)) ℛ⇩s⇩b)"
by simp
from direct_memop_step.WriteNonVolatile [OF ]
have "(Write False a (D, f) A L R W# is⇩s⇩b',
θ⇩s⇩b, (),m,𝒟,acquired True ?take_sb 𝒪⇩s⇩b ,release ?take_sb (dom (𝒮⇩s⇩b)) ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b',
θ⇩s⇩b, (), m(a := f θ⇩s⇩b), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom (𝒮⇩s⇩b)) ℛ⇩s⇩b, 𝒮)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (),𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom (𝒮⇩s⇩b)) ℛ⇩s⇩b)],
m(a := f θ⇩s⇩b),𝒮)".
moreover
have "∀j<length ts⇩s⇩b. i ≠ j ⟶
(let (_,_, _, sb⇩j,_,_,_) = ts⇩s⇩b ! j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j)"
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
hence "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
using outstanding_refs_append [of is_non_volatile_Write⇩s⇩b "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
have j_owns: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
from j_owns a_owned'' ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
show False
by auto
qed
}
thus ?thesis by (fastforce simp add: Let_def)
qed
note flush_commute = flush_all_until_volatile_write_append_non_volatile_write_commute
[OF True i_bound ts⇩s⇩b_i this]
from suspend_nothing
have suspend_nothing': "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = []"
by (simp add: sb')
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b
(sb@[Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼
(ts[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b,(),𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom (𝒮⇩s⇩b)) ℛ⇩s⇩b)],
m(a:=f θ⇩s⇩b),𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' sb' θ⇩s⇩b' 𝒟⇩s⇩b' )
using share_all_until_volatile_write_Write_commute
[OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i True 𝒟'
apply (clarsimp simp add: Let_def nth_list_update
outstanding_refs_conv ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' suspend_nothing' flush_all
acquired_append release_append split: if_split_asm)
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' sop' A' L' R' W' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
apply (auto)
subgoal for y ys
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends: "suspends = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
note flush_commute =
flush_all_until_volatile_write_append_unflushed [OF False i_bound ts⇩s⇩b_i]
have "Write⇩s⇩b True a' sop' v' A' L' R' W' ∈ set sb"
by (subst sb_split) auto
note drop_app = dropWhile_append1 [OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified]
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Write⇩s⇩b False a (D,f) (f θ⇩s⇩b) A L R W]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb')
using share_all_until_volatile_write_Write_commute
[OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
read_tmps_append suspends
prog_instrs_append_Write⇩s⇩b instrs_append_Write⇩s⇩b hd_prog_append_Write⇩s⇩b
drop "is⇩s⇩b" ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b'
θ⇩s⇩b' 𝒟⇩s⇩b' acquired_append takeWhile_append1 [OF r_in]
volatile_r
split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
qed
next
case (SBHWriteVolatile a D f A L R W)
then obtain
"is⇩s⇩b": "is⇩s⇩b = Write True a (D, f) A L R W# is⇩s⇩b'" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b" and
𝒟⇩s⇩b': "𝒟⇩s⇩b'=True" and
sb': "sb'=sb@[Write⇩s⇩b True a (D, f) (f θ⇩s⇩b) A L R W]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b"
by auto
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have D_subset: "D ⊆ dom θ⇩s⇩b"
by (simp add: is⇩s⇩b)
from safe_memop_flush_sb [simplified is⇩s⇩b] obtain
a_unowned_others_ts:
"∀j<length (map owned ts). i ≠ j ⟶ (a ∉ owned (ts!j) ∪ dom (released (ts!j)))" and
L_subset: "L ⊆ A" and
A_shared_owned: "A ⊆ dom (share ?drop_sb 𝒮) ∪ acquired True sb 𝒪⇩s⇩b" and
R_acq: "R ⊆ acquired True sb 𝒪⇩s⇩b" and
A_R: "A ∩ R = {}" and
A_unowned_by_others_ts:
"∀j<length (map owned ts). i≠j ⟶ (A ∩ (owned (ts!j) ∪ dom (released (ts!j))) = {})" and
a_not_ro': "a ∉ read_only (share ?drop_sb 𝒮)"
by cases auto
from a_unowned_others_ts ts_sim leq
have a_unowned_others:
"∀j<length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b!j in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
apply (clarsimp simp add: Let_def)
subgoal for j
apply (drule_tac x=j in spec)
apply (auto simp add: dom_release_takeWhile)
done
done
have a_not_ro: "a ∉ read_only (share sb 𝒮⇩s⇩b)"
proof
assume a: "a ∈ read_only (share sb 𝒮⇩s⇩b)"
from local.read_only_unowned_axioms have "read_only_unowned 𝒮⇩s⇩b ts⇩s⇩b".
from in_read_only_share_all_until_volatile_write' [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b
‹read_only_unowned 𝒮⇩s⇩b ts⇩s⇩b› i_bound ts⇩s⇩b_i a_unowned_others a]
have "a ∈ read_only (share ?drop_sb 𝒮)"
by (simp add: 𝒮)
with a_not_ro' show False by simp
qed
from A_unowned_by_others_ts ts_sim leq
have A_unowned_by_others:
"∀j<length ts⇩s⇩b. i≠j ⟶ (let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b!j
in A ∩ (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)) = {})"
apply (clarsimp simp add: Let_def)
subgoal for j
apply (drule_tac x=j in spec)
apply (force simp add: dom_release_takeWhile)
done
done
have a_not_acquired_others: "∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j,sb⇩j) = (map 𝒪_sb ts⇩s⇩b)!j in a ∉ all_acquired sb⇩j)"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "a ∈ all_acquired sb⇩j"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" ℛ⇩j 𝒟⇩s⇩b⇩j 𝒟⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j, 𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,
release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from a_unowned_others [rule_format,OF _ neq_i_j] ts⇩s⇩b_j j_bound
obtain a_unacq: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_not_shared: "a ∉ all_shared ?take_sb⇩j"
by auto
have conflict_drop: "a ∈ all_acquired suspends⇩j"
proof (rule ccontr)
assume "a ∉ all_acquired suspends⇩j"
with all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] conflict
have "a ∈ all_acquired ?take_sb⇩j"
by (auto simp add: suspends⇩j)
from all_acquired_unshared_acquired [OF this a_not_shared] a_unacq
show False by auto
qed
from j_bound''' i_bound' have j_bound_ts': "j < length ?ts'"
by simp
from split_all_acquired_in [OF conflict_drop]
show ?thesis
proof
assume "∃sop a' v ys zs A L R W.
suspends⇩j = ys @ Write⇩s⇩b True a' sop v A L R W# zs ∧ a ∈ A"
then
obtain a' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from sharing_consis [OF j_bound'' ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound'' ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Write⇩s⇩b True a' sop' v' A' L' R' W'# zs)) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(), True, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b]
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound' A'_R'
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs. suspends⇩j = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A"
then
obtain A' L' R' W' ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a_A': "a ∈ A'"
by blast
from sharing_consis [OF j_bound'' ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound'' ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Ghost⇩s⇩b A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Ghost⇩s⇩b A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Ghost⇩s⇩b A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Ghost⇩s⇩b A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Ghost⇩s⇩b A' L' R' W']" and sb'="zs", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) (ys@[Ghost⇩s⇩b A' L' R' W']),
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b (ys @ [Ghost⇩s⇩b A' L' R' W']) ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Ghost⇩s⇩b A' L' R' W']) (flush ?drop_sb m),
share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b,θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this i_bound_ys ts_ys_i, simplified is⇩s⇩b]
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound' A'_R'
show False
by (auto simp add: Let_def)
qed
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_unused_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j"
by auto
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,
release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b suspends⇩j"
proof -
from a'_in_j
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b (?take_sb⇩j @ ?drop_sb⇩j)"
by simp
thus ?thesis
apply (simp only: outstanding_refs_append suspends⇩j)
apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
done
qed
from split_volatile_Write⇩s⇩b_in_outstanding_refs [OF this]
obtain sop v ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop v A' L' R' W'# zs" (is "suspends⇩j = ?suspends")
by blast
from direct_memop_step.WriteVolatile [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Write True a (D, f) A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m,𝒟⇩s⇩b,acquired True sb 𝒪⇩s⇩b,
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,
share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), (flush ?drop_sb m)(a := f θ⇩s⇩b), True, acquired True sb 𝒪⇩s⇩b ∪ A - R, Map.empty,
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m,share ?drop_sb 𝒮 ) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (),
True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty)],
(flush ?drop_sb m)(a := f θ⇩s⇩b), share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L )"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Write⇩s⇩b True a' sop v A' L' R' W'# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Write⇩s⇩b True a' sop v A' L' R' W'# zs)), (), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
from a_unowned_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
obtain a_notin_owns_j: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_unshared: "a ∉ all_shared ?take_sb⇩j"
by auto
from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
have a_not_acquired_j: "a ∉ all_acquired sb⇩j"
by auto
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have a_no_non_vol_read: "a ∉ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
proof
assume a_in_nvr:"a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
from reads_consistent_drop [OF reads_consis]
have rc: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j)
?drop_sb⇩j"
by simp
from outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired [OF rc this a_in_nvr]
have a_owns_acq_ror:
"a ∈ 𝒪⇩j ∪ all_acquired sb⇩j ∪ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
simp add: acquired_takeWhile_non_volatile_Write⇩s⇩b)
have a_unowned_j: "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof (cases "a ∈ 𝒪⇩j")
case False with a_not_acquired_j show ?thesis by auto
next
case True
from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
have False by auto thus ?thesis ..
qed
with a_owns_acq_ror
have a_ror: "a ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] ts⇩s⇩b_j ts⇩s⇩b_i]
have a_unowned_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
from sharing_consis [OF j_bound'' ts⇩s⇩b_j] sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have consis_j_drop: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b) (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: )
from read_only_share_all_shared [OF this] a_unshared
have "a ∈ read_only 𝒮⇩s⇩b"
by fastforce
from read_only_unacquired_share [OF read_only_unowned [OF i_bound ts⇩s⇩b_i]
weak_sharing_consis [OF i_bound ts⇩s⇩b_i] this] a_unowned_sb
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
by auto
with a_not_ro show False
by simp
qed
with reads_consistent_mem_eq_on_non_volatile_reads [OF _ subset_refl reads_consis_flush_m]
have "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A suspends⇩j"
by (auto simp add: suspends⇩j)
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Write⇩s⇩b True a' sop v A' L' R' W'# zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Write⇩s⇩b True a' sop v A' L' R' W'# zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Write⇩s⇩b True a' sop v A' L' R' W'# zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a' sop v A' L' R' W' # zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,
share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a' sop v A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a' sop A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Write⇩s⇩b True a' sop v A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a' sop v A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have a_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in a' ∉ 𝒪⇩i)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
from a'_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_unaquired_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ all_acquired sb⇩j = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ all_acquired sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ all_acquired sb⇩j"
by auto
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from a'_in_j all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∈ all_acquired ?take_sb⇩j ∨ a' ∈ all_acquired suspends⇩j"
by (auto simp add: suspends⇩j)
thus False
proof
assume "a' ∈ all_acquired ?take_sb⇩j"
with A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound a'_in
show False
by (auto dest: all_acquired_unshared_acquired)
next
assume conflict_drop: "a' ∈ all_acquired suspends⇩j"
from split_all_acquired_in [OF conflict_drop]
show False
proof
assume "∃sop a'' v ys zs A L R W.
suspends⇩j = ys @ Write⇩s⇩b True a'' sop v A L R W# zs ∧ a' ∈ A"
then
obtain a'' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs"
(is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by auto
from direct_memop_step.WriteVolatile [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Write True a (D, f) A L R W # is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m ,𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b,
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,
share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), (flush ?drop_sb m)(a := f θ⇩s⇩b), True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty,
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b, (),True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty)],
(flush ?drop_sb m)(a := f θ⇩s⇩b),share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)), (), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
from a_unowned_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
obtain a_notin_owns_j: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_unshared: "a ∉ all_shared ?take_sb⇩j"
by auto
from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
have a_not_acquired_j: "a ∉ all_acquired sb⇩j"
by auto
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have a_no_non_vol_read: "a ∉ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
proof
assume a_in_nvr:"a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
from reads_consistent_drop [OF reads_consis]
have rc: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j)
?drop_sb⇩j"
by simp
from outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired [OF rc this a_in_nvr]
have a_owns_acq_ror:
"a ∈ 𝒪⇩j ∪ all_acquired sb⇩j ∪ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
simp add: acquired_takeWhile_non_volatile_Write⇩s⇩b)
have a_unowned_j: "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof (cases "a ∈ 𝒪⇩j")
case False with a_not_acquired_j show ?thesis by auto
next
case True
from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
have False by auto thus ?thesis ..
qed
with a_owns_acq_ror
have a_ror: "a ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] ts⇩s⇩b_j ts⇩s⇩b_i]
have a_unowned_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
from sharing_consis [OF j_bound'' ts⇩s⇩b_j] sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have consis_j_drop: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b) (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto)
from read_only_share_all_shared [OF this] a_unshared
have "a ∈ read_only 𝒮⇩s⇩b"
by fastforce
from read_only_unacquired_share [OF read_only_unowned [OF i_bound ts⇩s⇩b_i]
weak_sharing_consis [OF i_bound ts⇩s⇩b_i] this] a_unowned_sb
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
by auto
with a_not_ro show False
by simp
qed
with reads_consistent_mem_eq_on_non_volatile_reads [OF _ subset_refl reads_consis_flush_m]
have "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A suspends⇩j"
by (auto simp add: suspends⇩j)
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A, share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a'' sop' v' A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a'' sop' A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)),(),𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs.
suspends⇩j = ys @ Ghost⇩s⇩b A L R W # zs ∧ a' ∈ A"
then
obtain ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs" (is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by auto
from direct_memop_step.WriteVolatile [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Write True a (D, f) A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m,𝒟⇩s⇩b,acquired True sb 𝒪⇩s⇩b,
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,
share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), (flush ?drop_sb m)(a := f θ⇩s⇩b), True, acquired True sb 𝒪⇩s⇩b ∪ A - R, Map.empty,
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b, (), True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty)],
(flush ?drop_sb m)(a := f θ⇩s⇩b),share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Ghost⇩s⇩b A' L' R' W'# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Ghost⇩s⇩b A' L' R' W'# zs)), (),𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
from a_unowned_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
obtain a_notin_owns_j: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_unshared: "a ∉ all_shared ?take_sb⇩j"
by auto
from a_not_acquired_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
have a_not_acquired_j: "a ∉ all_acquired sb⇩j"
by auto
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have a_no_non_vol_read: "a ∉ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
proof
assume a_in_nvr:"a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
from reads_consistent_drop [OF reads_consis]
have rc: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j)
?drop_sb⇩j"
by simp
from outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired [OF rc this a_in_nvr]
have a_owns_acq_ror:
"a ∈ 𝒪⇩j ∪ all_acquired sb⇩j ∪ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
simp add: acquired_takeWhile_non_volatile_Write⇩s⇩b)
have a_unowned_j: "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof (cases "a ∈ 𝒪⇩j")
case False with a_not_acquired_j show ?thesis by auto
next
case True
from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
have False by auto thus ?thesis ..
qed
with a_owns_acq_ror
have a_ror: "a ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] ts⇩s⇩b_j ts⇩s⇩b_i]
have a_unowned_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
from sharing_consis [OF j_bound'' ts⇩s⇩b_j] sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have consis_j_drop: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b) (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto)
from read_only_share_all_shared [OF this] a_unshared
have "a ∈ read_only 𝒮⇩s⇩b"
by fastforce
from read_only_unacquired_share [OF read_only_unowned [OF i_bound ts⇩s⇩b_i]
weak_sharing_consis [OF i_bound ts⇩s⇩b_i] this] a_unowned_sb
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
by auto
with a_not_ro show False
by simp
qed
with reads_consistent_mem_eq_on_non_volatile_reads [OF _ subset_refl reads_consis_flush_m]
have "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A suspends⇩j"
by (auto simp add: suspends⇩j)
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Ghost⇩s⇩b A' L' R' W' # zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Ghost⇩s⇩b A' L' R' W'# zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Ghost⇩s⇩b A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,
share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Ghost⇩s⇩b A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Ghost A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)),(),𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
qed
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_no_read_only_reads_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map 𝒪_sb ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume conflict: "A ∩ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from split_in_read_only_reads [OF a'_in_j [simplified suspends⇩j [symmetric]]]
obtain t v ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Read⇩s⇩b False a' t v# zs" (is "suspends⇩j = ?suspends") and
a'_unacq: "a' ∉ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j)"
by blast
from direct_memop_step.WriteVolatile [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Write True a (D, f) A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,acquired True sb 𝒪⇩s⇩b,
release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), (flush ?drop_sb m)(a := f θ⇩s⇩b), True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty,
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (),
True, acquired True sb 𝒪⇩s⇩b ∪ A - R,Map.empty)],
(flush ?drop_sb m)(a := f θ⇩s⇩b),share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Read⇩s⇩b False a' t v# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Read⇩s⇩b False a' t v# zs)), (), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
from a_unowned_others [rule_format, OF j_bound'' neq_i_j ] j_bound ts⇩s⇩b_j
obtain a_notin_owns_j: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_unshared: "a ∉ all_shared ?take_sb⇩j"
by auto
from a_not_acquired_others [rule_format, OF j_bound neq_i_j] j_bound ts⇩s⇩b_j
have a_not_acquired_j: "a ∉ all_acquired sb⇩j"
by auto
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have a_no_non_vol_read: "a ∉ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
proof
assume a_in_nvr:"a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j"
from reads_consistent_drop [OF reads_consis]
have rc: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_j_drop: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j)
?drop_sb⇩j"
by simp
from outstanding_refs_non_volatile_Read⇩s⇩b_all_acquired [OF rc this a_in_nvr]
have a_owns_acq_ror:
"a ∈ 𝒪⇩j ∪ all_acquired sb⇩j ∪ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by (auto dest!: acquired_all_acquired_in all_acquired_takeWhile_dropWhile_in
simp add: acquired_takeWhile_non_volatile_Write⇩s⇩b)
have a_unowned_j: "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof (cases "a ∈ 𝒪⇩j")
case False with a_not_acquired_j show ?thesis by auto
next
case True
from all_shared_acquired_in [OF True a_unshared] a_notin_owns_j
have False by auto thus ?thesis ..
qed
with a_owns_acq_ror
have a_ror: "a ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
with read_only_reads_unowned [OF j_bound'' i_bound neq_i_j [symmetric] ts⇩s⇩b_j ts⇩s⇩b_i]
have a_unowned_sb: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
from sharing_consis [OF j_bound'' ts⇩s⇩b_j] sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have consis_j_drop: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b) (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from read_only_reads_read_only [OF nvo_j_drop consis_j_drop] a_ror a_unowned_j
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have "a ∈ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto)
from read_only_share_all_shared [OF this] a_unshared
have "a ∈ read_only 𝒮⇩s⇩b"
by fastforce
from read_only_unacquired_share [OF read_only_unowned [OF i_bound ts⇩s⇩b_i]
weak_sharing_consis [OF i_bound ts⇩s⇩b_i] this] a_unowned_sb
have "a ∈ read_only (share sb 𝒮⇩s⇩b)"
by auto
with a_not_ro show False
by simp
qed
with reads_consistent_mem_eq_on_non_volatile_reads [OF _ subset_refl reads_consis_flush_m]
have "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A suspends⇩j"
by (auto simp add: suspends⇩j)
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Read⇩s⇩b False a' t v# zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Read⇩s⇩b False a' t v# zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Read⇩s⇩b False a' t v# zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Read⇩s⇩b False a' t v# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,
share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Read⇩s⇩b False a' t v]) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Read False a' t#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Read⇩s⇩b False a' t v# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Read⇩s⇩b False a' t v# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have "a' ∈ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∨
a' ∈ read_only (share ys (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a'_unacq
have a'_ro: "a' ∈ read_only (share ys (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
from a'_in
have a'_not_ro: "a' ∉ read_only (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
have "a' ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
proof -
{
assume a_notin: "a' ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
from weak_sharing_consis [OF j_bound'' ts⇩s⇩b_j]
have "weak_sharing_consistent 𝒪⇩j sb⇩j".
with weak_sharing_consistent_append [of 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) suspends⇩j"
by (auto simp add: suspends⇩j)
with split_suspends⇩j
have weak_consis: "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) ys"
by (simp add: weak_sharing_consistent_append)
from all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "all_acquired ys ⊆ all_acquired sb⇩j"
apply (clarsimp)
apply (clarsimp simp add: suspends⇩j [symmetric] split_suspends⇩j all_acquired_append)
done
with a_notin acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪ all_acquired ys"
by auto
from read_only_share_unowned [OF weak_consis this a'_ro]
have "a' ∈ read_only (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" .
with a'_not_ro have False
by auto
}
thus ?thesis by blast
qed
moreover
from A_unaquired_by_others [rule_format, OF j_bound neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: Let_def)
moreover
from A_unowned_by_others [rule_format, OF j_bound'' neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto simp add: Let_def dest: all_shared_acquired_in)
moreover note a'_in
ultimately
show False
by auto
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]) "
by (auto simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
proof (cases "i⇩1=i")
case True
with i⇩1_j have i_j: "i≠j"
by simp
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence j_bound'': "j < length (map owned ts⇩s⇩b)"
by simp
from ts_j i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from a_unowned_others [rule_format, OF _ i_j] i_j ts_j j_bound
obtain a_notin_j: "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j" and
a_unshared: "a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by (auto simp add: Let_def ts⇩s⇩b')
from a_not_acquired_others [rule_format, OF _ i_j] i_j ts_j j_bound
have a_notin_acq: "a ∉ all_acquired sb⇩j"
by (auto simp add: Let_def ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i_bound j_bound' i_j ts⇩s⇩b_i ts_j']
have "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb = {}".
with ts_i⇩1 a_notin_j a_unshared a_notin_acq True i_bound show ?thesis
by (auto simp add: ts⇩s⇩b' sb' outstanding_refs_append
acquired_takeWhile_non_volatile_Write⇩s⇩b dest: all_shared_acquired_in)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b')
show ?thesis
proof (cases "j=i")
case True
from i⇩1_bound'
have i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by simp
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
have "(𝒪⇩s⇩b ∪ all_acquired sb) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}".
moreover
from A_unused_by_others [rule_format, OF _ False [symmetric]] False ts_i⇩1 i⇩1_bound
have "A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
by (auto simp add: Let_def ts⇩s⇩b')
ultimately
show ?thesis
using ts_j True ts⇩s⇩b'
by (auto simp add: i_bound ts⇩s⇩b' 𝒪⇩s⇩b' sb' all_acquired_append)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" .
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have "∀j<length ts⇩s⇩b. i ≠ j ⟶
(let (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j) = ts⇩s⇩b ! j
in (𝒪⇩s⇩b ∪ all_acquired sb') ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {})"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j acq⇩j θ⇩j sb⇩j
assume neq_i_j: "i ≠ j"
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j)"
have "(𝒪⇩s⇩b ∪ all_acquired sb') ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
proof -
{
fix a'
assume a'_in_i: "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb')"
assume a'_in_j: "a' ∈ (𝒪⇩j ∪ all_acquired sb⇩j)"
have False
proof -
from a'_in_i have "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb) ∨ a' ∈ A"
by (simp add: sb' all_acquired_append)
then show False
proof
assume "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb)"
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j] a'_in_j
show ?thesis
by auto
next
assume "a' ∈ A"
moreover
have j_bound': "j < length (map owned ts⇩s⇩b)"
using j_bound by auto
from A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
obtain "A ∩ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j = {}" and
"A ∩ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
by (auto simp add: Let_def)
moreover
from A_unaquired_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ all_acquired sb⇩j = {}"
by auto
ultimately
show ?thesis
using a'_in_j
by (auto dest: all_shared_acquired_in)
qed
qed
}
then show ?thesis by auto
qed
}
then show ?thesis by (fastforce simp add: Let_def)
qed
from ownership_distinct_nth_update [OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
moreover
from A_no_read_only_reads_by_others [rule_format, OF _ neq_n_i [symmetric]] n_bound' nth'
have "A ∩ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
by auto
ultimately
show ?thesis
using True ts⇩s⇩b_i nth' mth n_bound' m_bound'
by (auto simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' all_acquired_append)
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] ts⇩s⇩b_i mth']
then show ?thesis
using True neq_m_i ts⇩s⇩b_i nth mth n_bound' m_bound'
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append ts⇩s⇩b' sb' 𝒪⇩s⇩b')+
done
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
with valid_write_sops [OF i_bound ts⇩s⇩b_i] D_subset
valid_implies_valid_prog_hd [OF i_bound ts⇩s⇩b_i valid]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b (sb@[Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]))
(sb@ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])"
apply -
apply (rule history_consistent_appendI)
apply (auto simp add: hd_prog_append_Write⇩s⇩b)
done
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
from reads_consistent_snoc_Write⇩s⇩b [OF this]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])".
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have consis': "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
from A_shared_owned
have "A ⊆ dom (share ?drop_sb 𝒮) ∪ acquired True sb 𝒪⇩s⇩b"
by (simp add: sharing_consistent_append acquired_takeWhile_non_volatile_Write⇩s⇩b)
moreover have "dom (share ?drop_sb 𝒮) ⊆ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b)"
proof
fix a'
assume a'_in: "a' ∈ dom (share ?drop_sb 𝒮)"
from share_unshared_in [OF a'_in]
show "a' ∈ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b)"
proof
assume "a' ∈ dom (share ?drop_sb Map.empty)"
from share_mono_in [OF this] share_append [of ?take_sb ?drop_sb]
have "a' ∈ dom (share sb 𝒮⇩s⇩b)"
by auto
thus ?thesis
by simp
next
assume "a' ∈ dom 𝒮 ∧ a' ∉ all_unshared ?drop_sb"
thus ?thesis by auto
qed
qed
ultimately
have A_subset: "A ⊆ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
by auto
with A_unowned_by_others
have "A ⊆ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
proof -
{
fix x
assume x_A: "x ∈ A"
have "x ∈ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
proof -
{
assume "x ∈ dom 𝒮"
from share_all_until_volatile_write_share_acquired [OF ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b›
i_bound ts⇩s⇩b_i this [simplified 𝒮]]
A_unowned_by_others x_A
have ?thesis
by (fastforce simp add: Let_def)
}
with A_subset show ?thesis using x_A by auto
qed
}
thus ?thesis by blast
qed
with consis' L_subset A_R R_acq
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: sharing_consistent_append acquired_takeWhile_non_volatile_Write⇩s⇩b)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from a_not_ro no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'" by (simp add: "is⇩s⇩b")
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps (sb @ [Write⇩s⇩b True a (D, f) (f θ⇩s⇩b) A L R W])"
by (auto simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps (sb @ [Write⇩s⇩b True a (D, f) (f θ⇩s⇩b) A L R W]) ={}"
by (auto simp add: read_tmps_append "is⇩s⇩b")
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain valid_Df: "valid_sop (D,f)" and
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b")
from valid_Df valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_write_sops': "∀sop∈write_sops (sb@ [Write⇩s⇩b True a (D, f) (f θ⇩s⇩b) A L R W]).
valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound valid_write_sops' valid_store_sops']
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain D_indep: "D ∩ load_tmps is⇩s⇩b' = {}" and
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i] D_indep
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops (sb@ [Write⇩s⇩b True a (D, f) (f θ⇩s⇩b) A L R W])) ={}"
by (auto simp add: write_sops_append "is⇩s⇩b")
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ dom θ⇩s⇩b = {}"
by (auto simp add: "is⇩s⇩b")
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' θ⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ True ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]) = {}"
by (auto simp add: outstanding_refs_append )
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb' 𝒟⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b' (sb@[Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W])"
by (auto simp: causal_program_history_Write "is⇩s⇩b")
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b (sb @ [Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]) = p⇩s⇩b"
by (simp add: last_prog_append_Write⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is = Write True a (D,f) A L R W# is⇩s⇩b'"
by (simp add: "is⇩s⇩b")
with suspends_empty ts_i
have ts_i: "ts!i = (p⇩s⇩b, Write True a (D,f) A L R W# is⇩s⇩b', θ⇩s⇩b,(),𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
note flush_commute =
flush_all_until_volatile_write_append_volatile_write_commute
[OF True i_bound ts⇩s⇩b_i]
from True
have drop_app: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b)
(sb@[Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]) =
[Write⇩s⇩b True a (D,f) (f θ⇩s⇩b) A L R W]"
by (auto simp add: outstanding_refs_conv)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' θ⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' sb')
using share_all_until_volatile_write_Write_commute
[OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i
apply (clarsimp simp add: Let_def nth_list_update drop_app
ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' outstanding_refs_append takeWhile_tail flush_all
split: if_split_asm )
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by auto
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' A'' L'' R'' W'' sop' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
apply (auto)
subgoal for y ys
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends: "suspends = Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
note flush_commute =
flush_all_until_volatile_write_append_unflushed [OF False i_bound ts⇩s⇩b_i]
have "Write⇩s⇩b True a' sop' v' A'' L'' R'' W'' ∈ set sb"
by (subst sb_split) auto
note drop_app = dropWhile_append1
[OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified]
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb')
using share_all_until_volatile_write_Write_commute
[OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b]]
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b')
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i is_sim
apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
read_tmps_append suspends
prog_instrs_append_Write⇩s⇩b instrs_append_Write⇩s⇩b hd_prog_append_Write⇩s⇩b
drop "is⇩s⇩b" ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' outstanding_refs_append takeWhile_tail release_append split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
qed
next
case SBHFence
then obtain
"is⇩s⇩b": "is⇩s⇩b = Fence # is⇩s⇩b'" and
sb: "sb=[]" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=Map.empty" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b" and
𝒟⇩s⇩b': "¬ 𝒟⇩s⇩b'" and
sb': "sb'=sb" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b"
by auto
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b []"
by simp
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i subset_refl]
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i, of "[]" 𝒪⇩s⇩b]
show "read_only_reads_unowned ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show "ownership_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b []) []" by simp
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b []" by simp
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
have "non_volatile_writes_unshared 𝒮⇩s⇩b []"
by (simp add: sb)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb sb' 𝒮⇩s⇩b')
next
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b []" by simp
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' sb 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound, of "[]"]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb' sb)
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" split: instr.splits)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' "is⇩s⇩b")
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps []" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps [] = {}"
by (clarsimp)
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b" ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from valid_sops_nth_update [OF i_bound _ valid_store_sops', where sb= "[]" ]
show ?thesis by (auto simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops []) = {}"
by (auto simp add: write_sops_append)
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ dom θ⇩s⇩b = {}"
by (auto simp add: "is⇩s⇩b")
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: "is⇩s⇩b" ts⇩s⇩b' sb' sb θ⇩s⇩b')
qed
from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
have enough_flushs': "enough_flushs ts⇩s⇩b'"
by (auto simp add: ts⇩s⇩b' sb' sb)
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
have causal': "causal_program_history is⇩s⇩b' sb'"
by (simp add: "is⇩s⇩b" sb sb')
have "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb' sb)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
from is_sim have "is": "is = Fence # is⇩s⇩b'"
by (simp add: suspends sb "is⇩s⇩b")
with ts_i
have ts_i: "ts!i = (p⇩s⇩b, Fence # is⇩s⇩b', θ⇩s⇩b,(), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (simp add: suspends sb)
from direct_memop_step.Fence
have "(Fence # is⇩s⇩b',
θ⇩s⇩b, (),m,𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), m, False, acquired True ?take_sb 𝒪⇩s⇩b, Map.empty, 𝒮)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (), False, acquired True ?take_sb 𝒪⇩s⇩b,Map.empty)], m, 𝒮)".
moreover
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b,(), False,acquired True ?take_sb 𝒪⇩s⇩b,Map.empty)],m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' m
flush_all_until_volatile_nth_update_unused [OF i_bound ts⇩s⇩b_i])
using share_all_until_volatile_write_Fence_commute
[OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b sb]]
apply (clarsimp simp add: 𝒮 ts⇩s⇩b' 𝒮⇩s⇩b' is⇩s⇩b 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb' sb)
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim
apply (clarsimp simp add: Let_def nth_list_update
ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' 𝒟⇩s⇩b' ex_not θ⇩s⇩b'
split: if_split_asm )
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case (SBHRMWReadOnly cond t a D f ret A L R W)
then obtain
"is⇩s⇩b": "is⇩s⇩b = RMW a t (D,f) cond ret A L R W # is⇩s⇩b'" and
cond: "¬ (cond (θ⇩s⇩b(t↦m⇩s⇩b a)))" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=Map.empty" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b(t↦m⇩s⇩b a)" and
𝒟⇩s⇩b': "¬ 𝒟⇩s⇩b'" and
sb: "sb=[]" and
sb': "sb'=[]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b"
by auto
from safe_RMW_common [OF safe_memop_flush_sb [simplified is⇩s⇩b]]
obtain access_cond: "a ∈ 𝒪⇩s⇩b ∨ a ∈ dom 𝒮" and
rels_cond: " ∀j < length ts. i≠j ⟶ released (ts!j) a ≠ Some False"
by (auto simp add: 𝒮 sb)
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b []"
by simp
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i subset_refl]
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i, of "[]" 𝒪⇩s⇩b]
show "read_only_reads_unowned ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show "ownership_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent (θ⇩s⇩b(t↦m⇩s⇩b a)) (hd_prog p⇩s⇩b []) []" by simp
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' θ⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b []" by simp
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b []"
by (simp add: sb)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb sb' 𝒮⇩s⇩b')
next
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b []" by simp
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' sb 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound, of "[]"]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb' sb)
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" split: instr.splits)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' "is⇩s⇩b")
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps []" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps [] = {}"
by (clarsimp)
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b" ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from valid_sops_nth_update [OF i_bound _ valid_store_sops', where sb= "[]" ]
show ?thesis by (auto simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops []) = {}"
by (auto simp add: write_sops_append)
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps (RMW a t (D,f) cond ret A L R W# is⇩s⇩b') ∩ dom θ⇩s⇩b = {}"
by (simp add: "is⇩s⇩b")
moreover
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i] have "t ∉ load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b")
ultimately have "load_tmps is⇩s⇩b' ∩ dom (θ⇩s⇩b(t ↦ m⇩s⇩b a)) = {}"
by auto
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
have enough_flushs': "enough_flushs ts⇩s⇩b'"
by (auto simp add: ts⇩s⇩b' sb' sb)
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
have causal': "causal_program_history is⇩s⇩b' sb'"
by (simp add: "is⇩s⇩b" sb sb')
have "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb' sb)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W# is⇩s⇩b'"
by (simp add: suspends sb "is⇩s⇩b")
with ts_i
have ts_i: "ts!i = (p⇩s⇩b, RMW a t (D,f) cond ret A L R W# is⇩s⇩b', θ⇩s⇩b,(),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (simp add: suspends sb)
have "flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b a = m⇩s⇩b a"
proof -
have "∀j < length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j)"
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b ?take_sb⇩j"
with outstanding_refs_takeWhile [where P'= "Not ∘ is_volatile_Write⇩s⇩b"]
have a_in': "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
have j_owns: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
have no_unsharing:"release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j a ≠ Some False"
by (auto simp add: Let_def)
from access_cond
show False
proof
assume "a ∈ 𝒪⇩s⇩b"
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
j_owns
show False
by auto
next
assume a_shared: "a ∈ dom 𝒮"
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: 𝒮 domIff)
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
with non_volatile_writes_unshared_append [of 𝒮⇩s⇩b "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have unshared_take: "non_volatile_writes_unshared 𝒮⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by clarsimp
from release_not_unshared_no_write_take [OF unshared_take no_unsharing a_dom] a_in
show False by auto
qed
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
from flush_all_until_volatile_write_buffered_val_conv
[OF _ i_bound ts⇩s⇩b_i this]
show ?thesis
by (simp add: sb)
qed
hence m_a: "m a = m⇩s⇩b a"
by (simp add: m)
from cond have cond': "¬ cond (θ⇩s⇩b(t ↦ m a))"
by (simp add: m_a)
from direct_memop_step.RMWReadOnly [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond']
have "(RMW a t (D, f) cond ret A L R W # is⇩s⇩b',
θ⇩s⇩b, (),m, 𝒟, 𝒪⇩s⇩b, ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b', θ⇩s⇩b(t ↦ m a), (), m, False, 𝒪⇩s⇩b, Map.empty, 𝒮)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
have "(ts, m, 𝒮) ⇒⇩d (ts[i := (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b(t ↦ m a), (), False, 𝒪⇩s⇩b,Map.empty)], m, 𝒮)".
moreover
have tmps_commute: "θ⇩s⇩b(t ↦ (m⇩s⇩b a)) =
(θ⇩s⇩b |` (dom θ⇩s⇩b - {t}))(t ↦ (m⇩s⇩b a))"
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts[i := (p⇩s⇩b,is⇩s⇩b', θ⇩s⇩b(t ↦ m a),(), False,𝒪⇩s⇩b,Map.empty)],m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' m
flush_all_until_volatile_nth_update_unused [OF i_bound ts⇩s⇩b_i, simplified sb])
using share_all_until_volatile_write_RMW_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b sb]]
apply (clarsimp simp add: 𝒮 ts⇩s⇩b' 𝒮⇩s⇩b' is⇩s⇩b 𝒪⇩s⇩b' θ⇩s⇩b' sb' sb)
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim
apply (clarsimp simp add: Let_def nth_list_update
ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' ex_not m_a
split: if_split_asm)
apply (rule tmps_commute)
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case (SBHRMWWrite cond t a D f ret A L R W)
then obtain
"is⇩s⇩b": "is⇩s⇩b = RMW a t (D,f) cond ret A L R W # is⇩s⇩b'" and
cond: "(cond (θ⇩s⇩b(t↦m⇩s⇩b a)))" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b ∪ A - R" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=Map.empty" and
𝒟⇩s⇩b': "¬ 𝒟⇩s⇩b'" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b(t↦ret (m⇩s⇩b a) (f (θ⇩s⇩b(t↦m⇩s⇩b a))))" and
sb: "sb=[]" and
sb': "sb'=[]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b(a := f (θ⇩s⇩b(t↦m⇩s⇩b a)))" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L"
by auto
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have D_subset: "D ⊆ dom θ⇩s⇩b"
by (simp add: is⇩s⇩b)
from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W # is⇩s⇩b'"
by (simp add: suspends sb "is⇩s⇩b")
with ts_i
have ts_i: "ts!i = (p⇩s⇩b, RMW a t (D,f) cond ret A L R W # is⇩s⇩b', θ⇩s⇩b,(), 𝒟, 𝒪⇩s⇩b,ℛ⇩s⇩b)"
by (simp add: suspends sb)
from safe_RMW_common [OF safe_memop_flush_sb [simplified is⇩s⇩b]]
obtain access_cond: "a ∈ 𝒪⇩s⇩b ∨ a ∈ dom 𝒮" and
rels_cond: " ∀j < length ts. i≠j ⟶ released (ts!j) a ≠ Some False"
by (auto simp add: 𝒮 sb)
have a_unflushed:
"∀j < length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
proof -
{
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, xs⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j, ℛ⇩j)"
have "a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b ?take_sb⇩j"
with outstanding_refs_takeWhile [where P'= "Not ∘ is_volatile_Write⇩s⇩b"]
have a_in': "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound jth]]
have j_owns: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
have a_not_owns: "a ∉ 𝒪⇩s⇩b ∪ all_acquired sb"
by blast
assume a_in: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
with outstanding_refs_takeWhile [where P'= "Not ∘ is_volatile_Write⇩s⇩b"]
have a_in': "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
by auto
from rels_cond [rule_format, OF j_bound [simplified leq] neq_i_j] ts_sim [rule_format, OF j_bound] jth
have no_unsharing:"release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j a ≠ Some False"
by (auto simp add: Let_def)
from access_cond
show False
proof
assume "a ∈ 𝒪⇩s⇩b"
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
j_owns
show False
by auto
next
assume a_shared: "a ∈ dom 𝒮"
with share_all_until_volatile_write_thread_local [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b j_bound jth j_owns]
have a_dom: "a ∈ dom (share ?take_sb⇩j 𝒮⇩s⇩b)"
by (auto simp add: 𝒮 domIff)
from outstanding_non_volatile_writes_unshared [OF j_bound jth]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
with non_volatile_writes_unshared_append [of 𝒮⇩s⇩b "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have unshared_take: "non_volatile_writes_unshared 𝒮⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by clarsimp
from release_not_unshared_no_write_take [OF unshared_take no_unsharing a_dom] a_in
show False by auto
qed
qed
}
thus ?thesis
by (fastforce simp add: Let_def)
qed
have "flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b a = m⇩s⇩b a"
proof -
from flush_all_until_volatile_write_buffered_val_conv
[OF _ i_bound ts⇩s⇩b_i a_unflushed]
show ?thesis
by (simp add: sb)
qed
hence m_a: "m a = m⇩s⇩b a"
by (simp add: m)
from cond have cond': "cond (θ⇩s⇩b(t ↦ m a))"
by (simp add: m_a)
from safe_memop_flush_sb [simplified is⇩s⇩b] cond'
obtain
L_subset: "L ⊆ A" and
A_shared_owned: "A ⊆ dom 𝒮 ∪ 𝒪⇩s⇩b" and
R_owned: "R ⊆ 𝒪⇩s⇩b" and
A_R: "A ∩ R = {}" and
a_unowned_others_ts:
"∀j<length ts. i ≠ j ⟶ (a ∉ owned (ts!j) ∪ dom (released (ts!j)))" and
A_unowned_by_others_ts:
"∀j<length ts. i ≠ j ⟶ (A ∩ (owned (ts!j) ∪ dom (released (ts!j))) = {})" and
a_not_ro: "a ∉ read_only 𝒮"
by cases (auto simp add: sb)
from a_unowned_others_ts ts_sim leq
have a_unowned_others:
"∀j<length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b!j in
a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∧
a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
apply (clarsimp simp add: Let_def)
subgoal for j
apply (drule_tac x=j in spec)
apply (auto simp add: dom_release_takeWhile)
done
done
from A_unowned_by_others_ts ts_sim leq
have A_unowned_by_others:
"∀j<length ts⇩s⇩b. i≠j ⟶ (let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b!j
in A ∩ (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)) = {})"
apply (clarsimp simp add: Let_def)
subgoal for j
apply (drule_tac x=j in spec)
apply (force simp add: dom_release_takeWhile)
done
done
have a_not_ro': "a ∉ read_only 𝒮⇩s⇩b"
proof
assume a: "a ∈ read_only (𝒮⇩s⇩b)"
from local.read_only_unowned_axioms have "read_only_unowned 𝒮⇩s⇩b ts⇩s⇩b".
from in_read_only_share_all_until_volatile_write' [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b
‹read_only_unowned 𝒮⇩s⇩b ts⇩s⇩b› i_bound ts⇩s⇩b_i a_unowned_others, simplified sb, simplified,
OF a]
have "a ∈ read_only (𝒮)"
by (simp add: 𝒮)
with a_not_ro show False by simp
qed
{
fix j
fix p⇩j is⇩s⇩b⇩j 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j=(p⇩j,is⇩s⇩b⇩j,θ⇩j,sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i≠j"
have "a ∉ unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) {}"
proof
let ?take_sb⇩j = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
let ?drop_sb⇩j = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
assume a_in: "a ∈ unforwarded_non_volatile_reads ?drop_sb⇩j {}"
from a_unowned_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
obtain a_unacq_take: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j" and a_not_shared: "a ∉ all_shared ?take_sb⇩j"
by auto
note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound ts⇩s⇩b_j]
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j" .
note consis_j = sharing_consis [OF j_bound ts⇩s⇩b_j]
with sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
obtain consis_take_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j" and
consis_drop_j: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from in_unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b [OF a_in]
have a_in': "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j".
note reads_consis_j = valid_reads [OF j_bound ts⇩s⇩b_j]
from reads_consistent_drop [OF this]
have reads_consis_drop_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from read_only_share_all_shared [of a ?take_sb⇩j 𝒮⇩s⇩b] a_not_ro' a_not_shared
have a_not_ro_j: "a ∉ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by auto
from ts_sim [rule_format, OF j_bound] ts⇩s⇩b_j j_bound
obtain suspends⇩j "is⇩j" 𝒟⇩j where
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩j |` (dom θ⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (auto simp: Let_def)
from ts⇩j neq_i_j j_bound
have ts'_j: "?ts'!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩j |` (dom θ⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_last_prog [OF j_bound ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
from j_bound i_bound' leq have j_bound_ts': "j < length ?ts'"
by simp
from read_only_read_acquired_unforwarded_acquire_witness [OF nvo_drop_j consis_drop_j
a_not_ro_j a_unacq_take a_in]
have False
proof
assume "∃sop a' v ys zs A L R W.
?drop_sb⇩j= ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧ a ∈ A ∧
a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'≠a"
with suspends⇩j
obtain a' sop' v' ys zs' A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs'" (is "suspends⇩j=?suspends") and
a_A': "a ∈ A'" and
no_write: "a ∉ outstanding_refs is_Write⇩s⇩b (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by(auto simp add: outstanding_refs_append )
from last_prog
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from sharing_consis [OF j_bound ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_reads [OF j_bound ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']" and sb'="zs'", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs' @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs'" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Write⇩s⇩b True a' sop' v' A' L' R' W'# zs')) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']),
is⇩j',
θ⇩j |` (dom θ⇩j - read_tmps zs'),
(), True, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (flush ?drop_sb m),
share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from flush_unchanged_addresses [OF no_write]
have "flush (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W']) m a = m a".
with safe_delayedE [OF safe i_bound_ys ts_ys_i, simplified is⇩s⇩b] cond'
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b sb)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs. ?drop_sb⇩j = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys"
with suspends⇩j
obtain ys zs' A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs'" (is "suspends⇩j=?suspends") and
a_A': "a ∈ A'" and
no_write: "a ∉ outstanding_refs is_Write⇩s⇩b (ys @ [Ghost⇩s⇩b A' L' R' W'])"
by (auto simp add: outstanding_refs_append)
from last_prog
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from sharing_consis [OF j_bound ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_reads [OF j_bound ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m_j]
have reads_consis_flush_suspend: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) suspends⇩j".
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
(flush ?drop_sb m) (ys@[Ghost⇩s⇩b A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Ghost⇩s⇩b A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Ghost⇩s⇩b A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Ghost⇩s⇩b A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Ghost⇩s⇩b A' L' R' W']" and sb'="zs'", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts'_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="share ?drop_sb 𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs' @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs'" and
steps_ys: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d⇧*
(?ts'[j:=(last_prog
(hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs')) (ys@[Ghost⇩s⇩b A' L' R' W']),
is⇩j',
θ⇩j |` (dom θ⇩j - read_tmps zs'),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Ghost⇩s⇩b A' L' R' W']) (flush ?drop_sb m),
share (ys@[Ghost⇩s⇩b A' L' R' W']) (share ?drop_sb 𝒮))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,(),
𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = rtranclp_trans [OF steps_flush_sb steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from flush_unchanged_addresses [OF no_write]
have "flush (ys @ [Ghost⇩s⇩b A' L' R' W']) m a = m a".
with safe_delayedE [OF safe i_bound_ys ts_ys_i, simplified is⇩s⇩b] cond'
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b sb)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
show False
by (auto simp add: Let_def)
qed
then show False
by simp
qed
}
note a_notin_unforwarded_non_volatile_reads_drop = this
have A_unused_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ (𝒪⇩j ∪ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j) = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ (𝒪⇩j ∪ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j) ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a_in: "a' ∈ A" and
conflict: "a' ∈ 𝒪⇩j ∨ a' ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j"
by auto
from A_unowned_by_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j
have A_unshared_j: "A ∩ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
by (auto simp add: Let_def)
from conflict
show ?thesis
proof
assume "a' ∈ 𝒪⇩j"
from all_shared_acquired_in [OF this] A_unshared_j a_in
have conflict: "a' ∈ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j"
by (auto)
with A_unowned_by_others [rule_format, OF _ neq_i_j] j_bound ts⇩s⇩b_j a_in
show False by auto
next
assume a_in_j: "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j"
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b suspends⇩j"
proof -
from a_in_j
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b (?take_sb⇩j @ ?drop_sb⇩j)"
by simp
thus ?thesis
apply (simp only: outstanding_refs_append suspends⇩j)
apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
done
qed
from split_volatile_Write⇩s⇩b_in_outstanding_refs [OF this]
obtain sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs" (is "suspends⇩j = ?suspends")
by blast
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound''
ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
with non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by auto
from a_unowned_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have a_not_acq: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by auto
from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' ts⇩s⇩b_j neq_i_j]
have a_notin_unforwarded_reads: "a ∉ unforwarded_non_volatile_reads suspends⇩j {}"
by (simp add: suspends⇩j)
let ?ma="(m(a := f (θ⇩s⇩b(t↦m a))))"
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}"
and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j]
a_notin_unforwarded_reads
have reads_consis_ma_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma suspends⇩j"
by auto
from reads_consis_ma_j
have reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma (ys)"
by (simp add: split_suspends⇩j reads_consistent_append)
from direct_memop_step.RMWWrite [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond' ]
have "(RMW a t (D, f) cond ret A L R W# is⇩s⇩b', θ⇩s⇩b, (), m,𝒟, 𝒪⇩s⇩b, ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), ?ma, False, 𝒪⇩s⇩b ∪ A - R, Map.empty,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have step_a: "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)],
?ma,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_a, _, ?shared_a)").
from ts⇩j neq_i_j j_bound
have ts_a_j: "?ts_a!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom (𝒮⇩s⇩b)) ℛ⇩j)"
by auto
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b (ys) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto
from flush_store_buffer_append [where sb="ys" and sb'="Write⇩s⇩b True a' sop' v' A' L' R' W'#zs", simplified,
OF j_bound_ts_a is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_a_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?shared_a"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "Write True a' sop' A' L' R' W'# instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts_a, ?ma, ?shared_a) ⇒⇩d⇧*
(?ts_a[j:=(last_prog
(hd_prog p⇩j zs) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(), 𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')],
flush ys (?ma), share ys (?shared_a))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a' sop' A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))),(), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)"
by simp
from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
by auto
then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog p⇩j zs) ys, Write True a' sop' A' L' R' W'#is⇩j'', θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs), (), 𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by (clarsimp simp add: is⇩j')
note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j]
have a_unowned:
"∀i < length ts. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in a' ∉ 𝒪⇩i)"
apply cases
apply (auto simp add: Let_def)
done
from a_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_unacquired_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ all_acquired sb⇩j = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ all_acquired sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ all_acquired sb⇩j"
by auto
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" θ⇩s⇩b⇩j 𝒟⇩s⇩b⇩j ℛ⇩j 𝒟⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j,θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from a'_in_j all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∈ all_acquired ?take_sb⇩j ∨ a' ∈ all_acquired suspends⇩j"
by (auto simp add: suspends⇩j)
thus False
proof
assume "a' ∈ all_acquired ?take_sb⇩j"
with A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound a'_in
show False
by (auto dest: all_acquired_unshared_acquired)
next
assume conflict_drop: "a' ∈ all_acquired suspends⇩j"
from split_all_acquired_in [OF conflict_drop]
show ?thesis
proof
assume "∃sop a'' v ys zs A L R W.
suspends⇩j = ys @ Write⇩s⇩b True a'' sop v A L R W# zs ∧ a' ∈ A"
then
obtain a'' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs" (is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by blast
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF
‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j this]
have reads_consis_m_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
with non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by auto
from a_unowned_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have a_not_acq: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by auto
from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' ts⇩s⇩b_j neq_i_j]
have a_notin_unforwarded_reads: "a ∉ unforwarded_non_volatile_reads suspends⇩j {}"
by (simp add: suspends⇩j)
let ?ma="(m(a := f (θ⇩s⇩b(t↦m a))))"
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}"
and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j]
a_notin_unforwarded_reads
have reads_consis_ma_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma suspends⇩j"
by auto
from reads_consis_ma_j
have reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma (ys)"
by (simp add: split_suspends⇩j reads_consistent_append)
from direct_memop_step.RMWWrite [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond']
have "(RMW a t (D, f) cond ret A L R W# is⇩s⇩b',
θ⇩s⇩b, (), m, 𝒟, 𝒪⇩s⇩b, ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), ?ma, False, 𝒪⇩s⇩b ∪ A - R,Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
have step_a: "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)],
?ma,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_a, _, ?shared_a)").
from ts⇩j neq_i_j j_bound
have ts_a_j: "?ts_a!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b (ys) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto
from flush_store_buffer_append [where sb="ys" and sb'="Write⇩s⇩b True a'' sop' v' A' L' R' W'#zs", simplified,
OF j_bound_ts_a is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_a_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?shared_a"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "Write True a'' sop' A' L' R' W'# instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts_a, ?ma, ?shared_a) ⇒⇩d⇧*
(?ts_a[j:=(last_prog
(hd_prog p⇩j zs) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')],
flush ys (?ma),
share ys (?shared_a))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a'' sop' v' A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a'' sop' A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))),(), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)"
by simp
from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
by auto
then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog p⇩j zs) ys, Write True a'' sop' A' L' R' W'#is⇩j'',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs), (),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by (clarsimp simp add: is⇩j')
note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j]
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs. suspends⇩j = ys @ Ghost⇩s⇩b A L R W# zs ∧ a' ∈ A"
then
obtain ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs" (is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by blast
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF
‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j this]
have reads_consis_m_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound'' ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
with non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by auto
from a_unowned_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have a_not_acq: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by auto
from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound'' ts⇩s⇩b_j neq_i_j]
have a_notin_unforwarded_reads: "a ∉ unforwarded_non_volatile_reads suspends⇩j {}"
by (simp add: suspends⇩j)
let ?ma="(m(a := f (θ⇩s⇩b(t↦m a))))"
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}"
and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j]
a_notin_unforwarded_reads
have reads_consis_ma_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma suspends⇩j"
by auto
from reads_consis_ma_j
have reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma (ys)"
by (simp add: split_suspends⇩j reads_consistent_append)
from direct_memop_step.RMWWrite [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond']
have "(RMW a t (D, f) cond ret A L R W# is⇩s⇩b',
θ⇩s⇩b, (), m, 𝒟,𝒪⇩s⇩b, ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), ?ma, False, 𝒪⇩s⇩b ∪ A - R,Map.empty,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i [simplified sb, simplified] this]
have step_a: "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)],
?ma,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_a, _, ?shared_a)").
from ts⇩j neq_i_j j_bound
have ts_a_j: "?ts_a!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b (ys) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from j_bound' have j_bound_ts_a: "j < length ?ts_a" by auto
from flush_store_buffer_append [where sb="ys" and sb'="Ghost⇩s⇩b A' L' R' W'#zs", simplified,
OF j_bound_ts_a is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_a_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?shared_a"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "Ghost A' L' R' W'# instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts_a, ?ma, ?shared_a) ⇒⇩d⇧*
(?ts_a[j:=(last_prog
(hd_prog p⇩j zs) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')],
flush ys (?ma),
share ys (?shared_a))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Ghost⇩s⇩b A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Ghost A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))),(), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)"
by simp
from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
by auto
then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog p⇩j zs) ys, Ghost A' L' R' W'#is⇩j'',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps zs), (),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by (clarsimp simp add: is⇩j')
note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j]
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
qed
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
{
fix j
fix p⇩j is⇩s⇩b⇩j 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j=(p⇩j,is⇩s⇩b⇩j,θ⇩j,sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i≠j"
have "A ∩ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
proof -
{
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume conflict: "A ∩ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j ≠ {}"
have False
proof -
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from ts_sim [rule_format, OF j_bound] ts⇩s⇩b_j j_bound
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (clarsimp simp add: Let_def)
done
from split_in_read_only_reads [OF a'_in_j [simplified suspends⇩j [symmetric]]]
obtain t' v' ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Read⇩s⇩b False a' t' v'# zs" (is "suspends⇩j = ?suspends") and
a'_unacq: "a' ∉ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j)"
by blast
from valid_program_history [OF j_bound ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_last_prog [OF j_bound ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound
ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_volatile_refs_owned_or_read_only [OF j_bound ts⇩s⇩b_j]
have nvo_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
with non_volatile_owned_or_read_only_append [of False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have nvo_take_j: "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j"
by auto
from a_unowned_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have a_not_acq: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by auto
from a_notin_unforwarded_non_volatile_reads_drop[OF j_bound ts⇩s⇩b_j neq_i_j]
have a_notin_unforwarded_reads: "a ∉ unforwarded_non_volatile_reads suspends⇩j {}"
by (simp add: suspends⇩j)
let ?ma="(m(a := f (θ⇩s⇩b(t↦m a))))"
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads [where W="{}"
and m'="?ma",simplified, OF _ subset_refl reads_consis_m_j]
a_notin_unforwarded_reads
have reads_consis_ma_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma suspends⇩j"
by auto
from reads_consis_ma_j
have reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?ma (ys)"
by (simp add: split_suspends⇩j reads_consistent_append)
from direct_memop_step.RMWWrite [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond' ]
have "(RMW a t (D, f) cond ret A L R W# is⇩s⇩b', θ⇩s⇩b, (), m, 𝒟,𝒪⇩s⇩b,ℛ⇩s⇩b,𝒮) →
(is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), ?ma, False, 𝒪⇩s⇩b ∪ A - R,Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have step_a: "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))), (), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)],
?ma,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_a, _, ?shared_a)").
from ts⇩j neq_i_j j_bound
have ts_a_j: "?ts_a!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by auto
from valid_write_sops [OF j_bound ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b (ys) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from j_bound leq have j_bound_ts_a: "j < length ?ts_a" by auto
from flush_store_buffer_append [where sb="ys" and sb'="Read⇩s⇩b False a' t' v'#zs", simplified,
OF j_bound_ts_a is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_a_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?shared_a"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "Read False a' t'# instrs zs @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs" and
steps_ys: "(?ts_a, ?ma, ?shared_a) ⇒⇩d⇧*
(?ts_a[j:=(last_prog
(hd_prog p⇩j zs) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - insert t' (read_tmps zs)),
(), 𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')],
flush ys (?ma),
share ys (?shared_a))"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append)
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Read⇩s⇩b False a' t' v']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Read False a' t'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j
have ts_ys_i: "?ts_ys!i = (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t ↦ m a)))),(), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)"
by simp
from j_bound_ts_a have j_bound_ys: "j < length ?ts_ys"
by auto
then have ts_ys_j: "?ts_ys!j = (last_prog (hd_prog p⇩j zs) ys, Read False a' t'#is⇩j'', θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - insert t' (read_tmps zs)), (), 𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by (clarsimp simp add: is⇩j')
note conflict_computation = r_rtranclp_rtranclp [OF step_a steps_ys]
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j]
have "a' ∈ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∨
a' ∈ read_only (share ys (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a'_unacq
have a'_ro: "a' ∈ read_only (share ys (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
from a'_in
have a'_not_ro: "a' ∉ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
have "a' ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
proof -
{
assume a_notin: "a' ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
from weak_sharing_consis [OF j_bound ts⇩s⇩b_j]
have "weak_sharing_consistent 𝒪⇩j sb⇩j".
with weak_sharing_consistent_append [of 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) suspends⇩j"
by (auto simp add: suspends⇩j)
with split_suspends⇩j
have weak_consis: "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) ys"
by (simp add: weak_sharing_consistent_append)
from all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "all_acquired ys ⊆ all_acquired sb⇩j"
apply (clarsimp)
apply (clarsimp simp add: suspends⇩j [symmetric] split_suspends⇩j all_acquired_append)
done
with a_notin acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪ all_acquired ys"
by auto
from read_only_share_unowned [OF weak_consis this a'_ro]
have "a' ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" .
with a'_not_ro have False
by auto
with a_notin read_only_share_unowned [OF weak_consis _ a'_ro]
all_acquired_takeWhile [of "(Not ∘ is_volatile_Write⇩s⇩b)" sb⇩j]
have "a' ∈ read_only (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: acquired_takeWhile_non_volatile_Write⇩s⇩b)
with a'_not_ro have False
by auto
}
thus ?thesis by blast
qed
moreover
from A_unacquired_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: Let_def)
moreover
from A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto simp add: Let_def dest: all_shared_acquired_in)
moreover note a'_in
ultimately
show False
by auto
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
} note A_no_read_only_reads = this
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof
fix j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j p⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts⇩s⇩b'_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_owned_or_read_only False 𝒮⇩s⇩b' 𝒪⇩j sb⇩j"
proof (cases "j=i")
case True
have "non_volatile_owned_or_read_only False
(𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪⇩s⇩b ∪ A - R) []"
by simp
then show ?thesis
using True i_bound ts⇩s⇩b'_j
by (auto simp add: ts⇩s⇩b' 𝒮⇩s⇩b' sb sb')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with ts⇩s⇩b'_j False i_bound
have ts⇩s⇩b_j: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' ts⇩s⇩b_j]
from read_only_unowned [OF i_bound ts⇩s⇩b_i] R_owned
have "R ∩ read_only 𝒮⇩s⇩b = {}"
by auto
with A_no_read_only_reads [OF j_bound' ts⇩s⇩b_j False [symmetric]] L_subset
have "∀a∈read_only_reads
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j).
a ∈ read_only 𝒮⇩s⇩b ⟶ a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
have "non_volatile_owned_or_read_only False (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j".
thus ?thesis by (simp add: 𝒮⇩s⇩b')
qed
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
proof (cases "i⇩1=i")
case True
with ts_i⇩1 i_bound show ?thesis
by (simp add: ts⇩s⇩b' sb' sb)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b' sb' sb)
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by auto
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b' sb' sb)
show ?thesis
proof (cases "j=i")
case True
from i_bound ts_j ts⇩s⇩b' True have sb⇩j: "sb⇩j=[]"
by (simp add: ts⇩s⇩b' sb')
from A_unused_by_others [rule_format, OF _ False [symmetric]] ts_i⇩1 i⇩1_bound''
False i⇩1_bound'
have "A ∩ (𝒪⇩1 ∪ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1) = {}"
by (auto simp add: Let_def ts⇩s⇩b' 𝒪⇩s⇩b' sb' owned_def)
moreover
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
have "𝒪⇩s⇩b ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" by (simp add: sb)
ultimately show ?thesis using ts_j True
by (auto simp add: i_bound ts⇩s⇩b' 𝒪⇩s⇩b' sb⇩j)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" .
qed
qed
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
moreover
note A_no_read_only_reads [OF n_bound' nth']
ultimately
show ?thesis
using True ts⇩s⇩b_i neq_n_i nth mth n_bound' m_bound'
by (auto simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb sb')
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
with ts⇩s⇩b_i nth mth neq_m_i n_bound'
show ?thesis
by (auto simp add: ts⇩s⇩b' sb')
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩1 ∪ all_acquired sb⇩1) ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}"
proof (cases "i⇩1=i")
case True
with i⇩1_j have i_j: "i≠j"
by simp
from i_bound ts_i⇩1 ts⇩s⇩b' True have sb⇩1: "sb⇩1=[]"
by (simp add: ts⇩s⇩b' sb')
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence j_bound'': "j < length (map owned ts⇩s⇩b)"
by simp
from ts_j i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from A_unused_by_others [rule_format, OF _ i_j] ts_j i_j j_bound'
have "A ∩ (𝒪⇩j ∪ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j) = {}"
by (auto simp add: Let_def ts⇩s⇩b' owned_def)
moreover
from A_unacquired_by_others [rule_format, OF _ i_j] ts_j i_j j_bound'
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: Let_def ts⇩s⇩b')
moreover
from ownership_distinct [OF i_bound j_bound' i_j ts⇩s⇩b_i ts_j']
have "𝒪⇩s⇩b ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}" by (simp add: sb)
ultimately show ?thesis using ts_i⇩1 True
by (auto simp add: i_bound ts⇩s⇩b' 𝒪⇩s⇩b' sb' sb⇩1)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by simp
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b')
show ?thesis
proof (cases "j=i")
case True
from A_unused_by_others [rule_format, OF _ False [symmetric]] ts_i⇩1
False i⇩1_bound'
have "A ∩ (𝒪⇩1 ∪ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1) = {}"
by (auto simp add: Let_def ts⇩s⇩b' owned_def)
moreover
from A_unacquired_by_others [rule_format, OF _ False [symmetric]] ts_i⇩1 False i⇩1_bound'
have "A ∩ all_acquired sb⇩1 = {}"
by (auto simp add: Let_def ts⇩s⇩b' owned_def)
moreover
from ownership_distinct [OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
have "(𝒪⇩1 ∪ all_acquired sb⇩1) ∩ 𝒪⇩s⇩b = {}" by (simp add: sb)
ultimately show ?thesis
using ts_j True
by (auto simp add: i_bound ts⇩s⇩b' 𝒪⇩s⇩b' sb')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from ownership_distinct [OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩1 ∪ all_acquired sb⇩1) ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}" .
qed
qed
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent (θ⇩s⇩b(t↦ret (m⇩s⇩b a) (f (θ⇩s⇩b(t↦m⇩s⇩b a))))) (hd_prog p⇩s⇩b []) []" by simp
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' θ⇩s⇩b' sb' sb)
qed
from valid_reads [OF i_bound ts⇩s⇩b_i]
have reads_consis: "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j acq⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "reads_consistent False 𝒪⇩j m⇩s⇩b' sb⇩j"
proof (cases "i=j")
case True
from reads_consis ts_j j_bound sb show ?thesis
by (clarsimp simp add: True m⇩s⇩b' Write⇩s⇩b ts⇩s⇩b' sb')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
moreover from ts_j False have ts_j': "ts⇩s⇩b ! j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
using j_bound by (simp add: ts⇩s⇩b')
ultimately have consis_m: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j"
by (rule valid_reads)
let ?m' = "(m⇩s⇩b(a := f (θ⇩s⇩b(t ↦ m⇩s⇩b a))))"
from a_unowned_others [rule_format, OF _ False] j_bound' ts_j'
obtain a_acq: "a ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j" and
a_unsh: "a ∉ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by auto
with a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
have "∀a∈acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) {}.
?m' a = m⇩s⇩b a"
by auto
from reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop
[where W="{}",simplified, OF this _ _ consis_m]
acquired_reads_all_acquired' [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)" 𝒪⇩j]
have "reads_consistent False 𝒪⇩j (m⇩s⇩b(a := f (θ⇩s⇩b(t ↦ m⇩s⇩b a)))) sb⇩j"
by (auto simp del: fun_upd_apply)
thus ?thesis
by (simp add: m⇩s⇩b')
qed
qed
have valid_sharing': "valid_sharing (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with i_bound jth show ?thesis
by (simp add: ts⇩s⇩b' sb' sb)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
have unshared: "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
have "∀a∈dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
proof -
{
fix a
assume a_in: "a ∈ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b"
hence a_R: "a ∈ R"
by clarsimp
assume a_in_j: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
have False
proof -
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
a_in_j
have "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
moreover
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] a_R R_owned
show False
by blast
qed
}
thus ?thesis by blast
qed
from non_volatile_writes_unshared_no_outstanding_non_volatile_Write⇩s⇩b
[OF unshared this]
show ?thesis .
qed
qed
next
show "sharing_consis (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "sharing_consistent (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j"
proof (cases "i=j")
case True
with i_bound jth show ?thesis
by (simp add: ts⇩s⇩b' sb' sb)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from sharing_consis [OF j_bound' jth']
have consis: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have acq_cond: "all_acquired sb⇩j ∩ dom 𝒮⇩s⇩b - dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof -
{
fix a
assume a_acq: "a ∈ all_acquired sb⇩j"
assume "a ∈ dom 𝒮⇩s⇩b"
assume a_L: "a ∈ L"
have False
proof -
from A_unacquired_by_others [rule_format, of j,OF _ False] j_bound' jth'
have "A ∩ all_acquired sb⇩j = {}"
by auto
with a_acq a_L L_subset
show False
by blast
qed
}
thus ?thesis
by auto
qed
have uns_cond: "all_unshared sb⇩j ∩ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b = {}"
proof -
{
fix a
assume a_uns: "a ∈ all_unshared sb⇩j"
assume "a ∉ L"
assume a_R: "a ∈ R"
have False
proof -
from unshared_acquired_or_owned [OF consis] a_uns
have "a ∈ all_acquired sb⇩j ∪ 𝒪⇩j" by auto
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] R_owned a_R
show False
by blast
qed
}
thus ?thesis
by auto
qed
from sharing_consistent_preservation [OF consis acq_cond uns_cond]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
qed
next
show "unowned_shared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
show "- ⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') ⊆ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof -
have s: "⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') =
⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b) ∪ A - R"
apply (unfold ts⇩s⇩b' 𝒪⇩s⇩b')
apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound ts⇩s⇩b_i])
apply fact
done
note unowned_shared L_subset A_R
then
show ?thesis
apply (simp only: s)
apply auto
done
qed
qed
next
show "read_only_unowned (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof (cases "i=j")
case True
from read_only_unowned [OF i_bound ts⇩s⇩b_i] R_owned A_R
have "(𝒪⇩s⇩b ∪ A - R) ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs )
with jth ts⇩s⇩b_i i_bound True
show ?thesis
by (auto simp add: 𝒪⇩s⇩b' ts⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from read_only_unowned [OF j_bound' jth']
have "𝒪⇩j ∩ read_only 𝒮⇩s⇩b = {}".
moreover
from A_unowned_by_others [rule_format, OF _ False] j_bound' jth'
have "A ∩ 𝒪⇩j = {}"
by (auto dest: all_shared_acquired_in )
moreover
from ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
have "𝒪⇩s⇩b ∩ 𝒪⇩j = {}"
by auto
moreover note R_owned A_R
ultimately show ?thesis
by (fastforce simp add: in_read_only_convs split: if_split_asm)
qed
qed
next
show "no_outstanding_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "no_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with jth ts⇩s⇩b_i i_bound
show ?thesis
by (auto simp add: sb sb' ts⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
have nw: "no_write_to_read_only_memory 𝒮⇩s⇩b sb⇩j".
have "R ∩ outstanding_refs is_Write⇩s⇩b sb⇩j = {}"
proof -
note dist = ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
dist
have "outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
moreover
from outstanding_volatile_writes_unowned_by_others [OF j_bound' i_bound
False [symmetric] jth' ts⇩s⇩b_i ]
have "outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
ultimately have "outstanding_refs is_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by (auto simp add: misc_outstanding_refs_convs)
with R_owned
show ?thesis by blast
qed
then
have "∀a∈outstanding_refs is_Write⇩s⇩b sb⇩j.
a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: in_read_only_convs)
from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
show ?thesis .
qed
qed
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" split: instr.splits)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' "is⇩s⇩b")
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps []" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps [] = {}"
by (clarsimp)
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b" ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
from valid_sops_nth_update [OF i_bound _ valid_store_sops', where sb= "[]" ]
show ?thesis by (auto simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops []) = {}"
by (auto simp add: write_sops_append)
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb' sb 𝒪⇩s⇩b')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps (RMW a t (D,f) cond ret A L R W # is⇩s⇩b') ∩ dom θ⇩s⇩b = {}"
by (simp add: "is⇩s⇩b")
moreover
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i] have "t ∉ load_tmps is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b")
ultimately have "load_tmps is⇩s⇩b' ∩ dom (θ⇩s⇩b(t ↦ ret (m⇩s⇩b a) (f (θ⇩s⇩b(t↦m⇩s⇩b a))))) = {}"
by auto
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
from enough_flushs_nth_update [OF i_bound, where sb="[]" ]
have enough_flushs': "enough_flushs ts⇩s⇩b'"
by (auto simp: ts⇩s⇩b' sb' sb)
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
have causal': "causal_program_history is⇩s⇩b' sb'"
by (simp add: "is⇩s⇩b" sb sb')
have "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb' sb)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
from is_sim have "is": "is = RMW a t (D,f) cond ret A L R W # is⇩s⇩b'"
by (simp add: suspends sb "is⇩s⇩b")
from direct_memop_step.RMWWrite [where cond=cond and θ=θ⇩s⇩b and m=m, OF cond']
have "(RMW a t (D, f) cond ret A L R W # is⇩s⇩b', θ⇩s⇩b, (),m, 𝒟, 𝒪⇩s⇩b,ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b',θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t↦m a)))), (),
m(a := f (θ⇩s⇩b(t ↦ m a))), False, 𝒪⇩s⇩b ∪ A - R, Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d (ts[i := (p⇩s⇩b, is⇩s⇩b',θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t↦m a)))), (), False, 𝒪⇩s⇩b ∪ A - R,Map.empty)],
m(a := f (θ⇩s⇩b(t ↦ m a))),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
moreover
have tmps_commute: "θ⇩s⇩b(t ↦ ret (m⇩s⇩b a) (f (θ⇩s⇩b(t↦m⇩s⇩b a)))) =
(θ⇩s⇩b |` (dom θ⇩s⇩b - {t}))(t ↦ ret (m⇩s⇩b a) (f (θ⇩s⇩b(t↦m⇩s⇩b a))))"
apply (rule ext)
apply (auto simp add: restrict_map_def domIff)
done
from a_unflushed ts⇩s⇩b_i sb
have a_unflushed':
"∀j < length ts⇩s⇩b.
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j
in a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
by auto
have all_shared_L: "∀i p is 𝒪 ℛ 𝒟 acq θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_L: "x ∈ L"
have False
proof (cases "i=j")
case True with x_shared ts⇩s⇩b_i jth show False by (simp add: sb)
next
case False
show False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
from A_unacquired_by_others [rule_format, OF _ False] jth j_bound
have "A ∩ all_acquired sb⇩j = {}" by auto
moreover
from A_unowned_by_others [rule_format, OF _ False] jth j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto dest: all_shared_acquired_in)
ultimately
show False
using L_subset x_L x_shared
by blast
qed
qed
}
thus ?thesis by blast
qed
have all_shared_A: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_A: "x ∈ A"
have False
proof (cases "i=j")
case True with x_shared ts⇩s⇩b_i jth show False by (simp add: sb)
next
case False
show False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
from A_unacquired_by_others [rule_format, OF _ False] jth j_bound
have "A ∩ all_acquired sb⇩j = {}" by auto
moreover
from A_unowned_by_others [rule_format, OF _ False] jth j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto dest: all_shared_acquired_in)
ultimately
show False
using x_A x_shared
by blast
qed
qed
}
thus ?thesis by blast
qed
hence all_shared_L: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
using L_subset by blast
have all_unshared_R: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_unshared: "x ∈ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof (cases "i=j")
case True with x_unshared ts⇩s⇩b_i jth show False by (simp add: sb)
next
case False
show False
proof -
from unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_unshared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_unshared sb⇩j"
using all_unshared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound False ts⇩s⇩b_i jth]
ultimately
show False
using R_owned x_R x_unshared
by blast
qed
qed
}
thus ?thesis by blast
qed
have all_acquired_R: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_acq: "x ∈ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof (cases "i=j")
case True with x_acq ts⇩s⇩b_i jth show False by (simp add: sb)
next
case False
show False
proof -
from x_acq have "x ∈ all_acquired sb⇩j"
using all_acquired_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound False ts⇩s⇩b_i jth]
ultimately
show False
using R_owned x_R
by blast
qed
qed
}
thus ?thesis by blast
qed
have all_shared_R: "∀i p is 𝒪 ℛ 𝒟 θ sb. i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof (cases "i=j")
case True with x_shared ts⇩s⇩b_i jth show False by (simp add: sb)
next
case False
show False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound False ts⇩s⇩b_i jth]
ultimately
show False
using R_owned x_R x_shared
by blast
qed
qed
}
thus ?thesis by blast
qed
from share_all_until_volatile_write_commute [OF ‹ownership_distinct ts⇩s⇩b› ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b›
all_shared_L all_shared_A all_acquired_R all_unshared_R all_shared_R]
have share_commute: "share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L =
share_all_until_volatile_write ts⇩s⇩b (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)".
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume j_bound: "j < length ts⇩s⇩b"
assume neq: "i ≠ j"
have "release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b ∪ R - L) ℛ⇩j
= release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b) ℛ⇩j"
proof -
{
fix a
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
have "(a ∈ (dom 𝒮⇩s⇩b ∪ R - L)) = (a ∈ dom 𝒮⇩s⇩b)"
proof -
from A_unowned_by_others [rule_format, OF j_bound neq ] jth
A_unacquired_by_others [rule_format, OF _ neq] j_bound
have A_dist: "A ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by (auto dest: all_shared_acquired_in)
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have a_in: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i jth]
have "a ∉ (𝒪⇩s⇩b ∪ all_acquired sb)" by auto
with A_dist R_owned A_R A_shared_owned L_subset a_in
obtain "a ∉ R" and "a ∉ L"
by fastforce
then show ?thesis by auto
qed
}
then
show ?thesis
apply -
apply (rule release_all_shared_exchange)
apply auto
done
qed
}
note release_commute = this
have "(ts⇩s⇩b',m⇩s⇩b(a := f (θ⇩s⇩b(t ↦ m⇩s⇩b a))),𝒮⇩s⇩b') ∼ (ts[i := (p⇩s⇩b,is⇩s⇩b',
θ⇩s⇩b(t ↦ ret (m a) (f (θ⇩s⇩b(t↦m a)))),(), False,𝒪⇩s⇩b ∪ A - R,Map.empty)],m(a := f (θ⇩s⇩b(t ↦ m a))),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply (rule sim_config.intros)
apply (simp only: m_a )
apply (simp only: m)
apply (simp only: flush_all_until_volatile_write_update_other [OF a_unflushed', symmetric] ts⇩s⇩b')
apply (simp add: flush_all_until_volatile_nth_update_unused [OF i_bound ts⇩s⇩b_i, simplified sb] sb')
apply (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' m
flush_all_until_volatile_nth_update_unused [OF i_bound ts⇩s⇩b_i, simplified sb])
using share_all_until_volatile_write_RMW_commute [OF i_bound ts⇩s⇩b_i [simplified is⇩s⇩b sb]]
apply (clarsimp simp add: 𝒮 ts⇩s⇩b' 𝒮⇩s⇩b' is⇩s⇩b 𝒪⇩s⇩b' ℛ⇩s⇩b' θ⇩s⇩b' sb' sb share_commute)
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim
apply (clarsimp simp add: Let_def nth_list_update
ts⇩s⇩b' sb' sb 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' ex_not m_a
split: if_split_asm)
apply (rule conjI)
apply clarsimp
apply (rule tmps_commute)
apply clarsimp
apply (frule (2) release_commute)
apply clarsimp
apply fastforce
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case (SBHGhost A L R W)
then obtain
"is⇩s⇩b": "is⇩s⇩b = Ghost A L R W# is⇩s⇩b'" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b" and
θ⇩s⇩b': "θ⇩s⇩b' = θ⇩s⇩b" and
𝒟⇩s⇩b': "𝒟⇩s⇩b'=𝒟⇩s⇩b" and
sb': "sb'=sb@[Ghost⇩s⇩b A L R W]" and
m⇩s⇩b': "m⇩s⇩b' = m⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b"
by auto
from safe_memop_flush_sb [simplified is⇩s⇩b] obtain
L_subset: "L ⊆ A" and
A_shared_owned: "A ⊆ dom (share ?drop_sb 𝒮) ∪ acquired True sb 𝒪⇩s⇩b" and
R_acq: "R ⊆ acquired True sb 𝒪⇩s⇩b" and
A_R: "A ∩ R = {}" and
A_unowned_by_others_ts:
"∀j<length (map owned ts). i≠j ⟶ (A ∩ (owned (ts!j) ∪ dom (released (ts!j))) = {})"
by cases auto
from A_unowned_by_others_ts ts_sim leq
have A_unowned_by_others:
"∀j<length ts⇩s⇩b. i≠j ⟶ (let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b!j
in A ∩ (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)) = {})"
apply (clarsimp simp add: Let_def)
subgoal for j
apply (drule_tac x=j in spec)
apply (force simp add: dom_release_takeWhile)
done
done
have A_unused_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j"
by auto
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" θ⇩s⇩b⇩j 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j,θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b suspends⇩j"
proof -
from a'_in_j
have "a' ∈ outstanding_refs is_volatile_Write⇩s⇩b (?take_sb⇩j @ ?drop_sb⇩j)"
by simp
thus ?thesis
apply (simp only: outstanding_refs_append suspends⇩j)
apply (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
done
qed
from split_volatile_Write⇩s⇩b_in_outstanding_refs [OF this]
obtain sop v ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop v A' L' R' W' # zs" (is "suspends⇩j = ?suspends")
by blast
from direct_memop_step.Ghost [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b),
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (),𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b ∪ A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
flush ?drop_sb m,share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Write⇩s⇩b True a' sop v A' L' R' W' # zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Write⇩s⇩b True a' sop v A' L' R' W' # zs)), (), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
?m_A suspends⇩j".
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Write⇩s⇩b True a' sop v A' L' R' W' # zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Write⇩s⇩b True a' sop v A' L' R' W' # zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Write⇩s⇩b True a' sop v A' L' R' W' # zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a' sop v A' L' R' W' # zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,
share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a' sop v A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a' sop A' L' R' W' #is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Write⇩s⇩b True a' sop v A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a' sop v A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have a_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in a' ∉ 𝒪⇩i)"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
from a'_in a_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_unaquired_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ all_acquired sb⇩j = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
assume conflict: "A ∩ all_acquired sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ all_acquired sb⇩j"
by auto
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" θ⇩s⇩b⇩j 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from a'_in_j all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∈ all_acquired ?take_sb⇩j ∨ a' ∈ all_acquired suspends⇩j"
by (auto simp add: suspends⇩j)
thus False
proof
assume "a' ∈ all_acquired ?take_sb⇩j"
with A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound a'_in
show False
by (auto dest: all_acquired_unshared_acquired)
next
assume conflict_drop: "a' ∈ all_acquired suspends⇩j"
from split_all_acquired_in [OF conflict_drop]
show False
proof
assume "∃sop a'' v ys zs A L R W.
suspends⇩j = ys @ Write⇩s⇩b True a'' sop v A L R W# zs ∧ a' ∈ A"
then
obtain a'' sop' v' ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs"
(is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by auto
from direct_memop_step.Ghost [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m,𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b),
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b',θ⇩s⇩b, (),𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
flush ?drop_sb m,share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)), (), 𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j, release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
?m_A suspends⇩j".
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W' # zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Write⇩s⇩b True a'' sop' v' A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Write True a'' sop' A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs.
suspends⇩j = ys @ Ghost⇩s⇩b A L R W # zs ∧ a' ∈ A"
then
obtain ys zs A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs" (is "suspends⇩j = ?suspends") and
a'_A': "a' ∈ A'"
by auto
from direct_memop_step.Ghost [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b),
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (), 𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b ∪ A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
flush ?drop_sb m,share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Ghost⇩s⇩b A' L' R' W'# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Ghost⇩s⇩b A' L' R' W'# zs)), (),𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
?m_A suspends⇩j".
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Ghost⇩s⇩b A' L' R' W'# zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Ghost⇩s⇩b A' L' R' W'# zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Ghost⇩s⇩b A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A, share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Ghost⇩s⇩b A' L' R' W']) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Ghost A' L' R' W'#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Write⇩s⇩b True a'' sop' v' A' L' R' W'# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have A'_unowned:
"∀i < length ?ts_ys. j≠i ⟶ (let (𝒪⇩i) = map owned ?ts_ys!i in A' ∩ 𝒪⇩i = {})"
apply cases
apply (fastforce simp add: Let_def is⇩s⇩b)+
done
from a'_in a'_A' A'_unowned [rule_format, of i] neq_i_j i_bound' A_R
show False
by (auto simp add: Let_def)
qed
qed
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have A_no_read_only_reads_by_others:
"∀j<length (map 𝒪_sb ts⇩s⇩b). i ≠ j ⟶
(let (𝒪⇩j, sb⇩j) = map 𝒪_sb ts⇩s⇩b! j
in A ∩ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {})"
proof -
{
fix j 𝒪⇩j sb⇩j
assume j_bound: "j < length (map owned ts⇩s⇩b)"
assume neq_i_j: "i≠j"
assume ts⇩s⇩b_j: "(map 𝒪_sb ts⇩s⇩b)!j = (𝒪⇩j,sb⇩j)"
let ?take_sb⇩j = "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
let ?drop_sb⇩j = "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume conflict: "A ∩ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j ≠ {}"
have False
proof -
from j_bound leq
have j_bound': "j < length (map owned ts)"
by auto
from j_bound have j_bound'': "j < length ts⇩s⇩b"
by auto
from j_bound' have j_bound''': "j < length ts"
by simp
from conflict obtain a' where
a'_in: "a' ∈ A" and
a'_in_j: "a' ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from ts_sim [rule_format, OF j_bound''] ts⇩s⇩b_j j_bound''
obtain p⇩j suspends⇩j "is⇩s⇩b⇩j" 𝒟⇩s⇩b⇩j 𝒟⇩j ℛ⇩j θ⇩s⇩b⇩j "is⇩j" where
ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j,is⇩s⇩b⇩j, θ⇩s⇩b⇩j, sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)" and
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps suspends⇩j),(), 𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
apply (cases "ts⇩s⇩b!j")
apply (force simp add: Let_def)
done
from split_in_read_only_reads [OF a'_in_j [simplified suspends⇩j [symmetric]]]
obtain t v ys zs where
split_suspends⇩j: "suspends⇩j = ys @ Read⇩s⇩b False a' t v# zs" (is "suspends⇩j = ?suspends") and
a'_unacq: "a' ∉ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j)"
by blast
from direct_memop_step.Ghost [where θ=θ⇩s⇩b and m="flush ?drop_sb m"]
have "(Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b, release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, share ?drop_sb 𝒮) →
(is⇩s⇩b', θ⇩s⇩b, (), flush ?drop_sb m, 𝒟⇩s⇩b,
acquired True sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b),
share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF
i_bound_ts' [simplified is⇩s⇩b] ts'_i [simplified is⇩s⇩b] this [simplified is⇩s⇩b]]
have store_step: "(?ts', flush ?drop_sb m, share ?drop_sb 𝒮) ⇒⇩d
(?ts'[i := (p⇩s⇩b, is⇩s⇩b', θ⇩s⇩b, (),𝒟⇩s⇩b, acquired True sb 𝒪⇩s⇩b ∪ A - R,augment_rels (dom (share ?drop_sb 𝒮)) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
flush ?drop_sb m,share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
(is " _ ⇒⇩d (?ts_A, ?m_A, ?share_A)")
by (simp add: is⇩s⇩b)
from i_bound' have i_bound'': "i < length ?ts_A"
by simp
from valid_program_history [OF j_bound'' ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from ts⇩j neq_i_j j_bound
have ts_A_j: "?ts_A!j = (hd_prog p⇩j (ys @ Read⇩s⇩b False a' t v# zs), is⇩j,
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (ys @ Read⇩s⇩b False a' t v# zs)), (),𝒟⇩j,
acquired True ?take_sb⇩j 𝒪⇩j,release ?take_sb⇩j (dom 𝒮⇩s⇩b) ℛ⇩j)"
by (simp add: split_suspends⇩j)
from j_bound''' i_bound' neq_i_j have j_bound'''': "j < length ?ts_A"
by simp
from valid_last_prog [OF j_bound'' ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
then
have lp: "last_prog p⇩j ?suspends = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_reads [OF j_bound'' ts⇩s⇩b_j]
have reads_consis: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b› j_bound''
ts⇩s⇩b_j reads_consis]
have reads_consis_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
from outstanding_non_write_non_vol_reads_drop_disj [OF i_bound j_bound'' neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
have "outstanding_refs is_Write⇩s⇩b ?drop_sb ∩ outstanding_refs is_non_volatile_Read⇩s⇩b suspends⇩j = {}"
by (simp add: suspends⇩j)
from reads_consistent_flush_independent [OF this reads_consis_m]
have reads_consis_flush_m: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
?m_A suspends⇩j".
hence reads_consis_m_A_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) ?m_A ys"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_history [OF j_bound'' ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from valid_write_sops [OF j_bound'' ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops ys. valid_sop sop"
apply (simp only: write_sops_append )
apply auto
done
from read_tmps_distinct [OF j_bound'' ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop h_consis]
last_prog_hd_prog
have hist_consis': "history_consistent θ⇩s⇩b⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b ys = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
from flush_store_buffer_append [
OF j_bound'''' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts_A_j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_m_A_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="?share_A"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs (Read⇩s⇩b False a' t v # zs) @ is⇩s⇩b⇩j =
is⇩j' @ prog_instrs (Read⇩s⇩b False a' t v # zs)" and
steps_ys: "(?ts_A, ?m_A, ?share_A) ⇒⇩d⇧*
(?ts_A[j:= (last_prog (hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs)) ys,
is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Read⇩s⇩b False a' t v # zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j') ],
flush ys ?m_A,
share ys ?share_A)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto)
note conflict_computation = rtranclp_trans [OF rtranclp_r_rtranclp [OF steps_flush_sb, OF store_step] steps_ys]
from cph
have "causal_program_history is⇩s⇩b⇩j ((ys @ [Read⇩s⇩b False a' t v]) @ zs)"
by simp
from causal_program_history_suffix [OF this]
have cph': "causal_program_history is⇩s⇩b⇩j zs".
interpret causal⇩j: causal_program_history "is⇩s⇩b⇩j" "zs" by (rule cph')
from causal⇩j.causal_program_history [of "[]", simplified, OF refl] is⇩j'
obtain is⇩j''
where is⇩j': "is⇩j' = Read False a' t#is⇩j''" and
is⇩j'': "instrs zs @ is⇩s⇩b⇩j = is⇩j'' @ prog_instrs zs"
by clarsimp
from j_bound'''
have j_bound_ys: "j < length ?ts_ys"
by auto
from j_bound_ys neq_i_j
have ts_ys_j: "?ts_ys!j=(last_prog (hd_prog p⇩j (Read⇩s⇩b False a' t v# zs)) ys, is⇩j',
θ⇩s⇩b⇩j |` (dom θ⇩s⇩b⇩j - read_tmps (Read⇩s⇩b False a' t v# zs)),(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {},
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j),ℛ⇩j')"
by auto
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
from safe_delayedE [OF this j_bound_ys ts_ys_j, simplified is⇩j']
have "a' ∈ acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∨
a' ∈ read_only (share ys (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
apply cases
apply (auto simp add: Let_def is⇩s⇩b)
done
with a'_unacq
have a'_ro: "a' ∈ read_only (share ys (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by auto
from a'_in
have a'_not_ro: "a' ∉ read_only (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs)
have "a' ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
proof -
{
assume a_notin: "a' ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
from weak_sharing_consis [OF j_bound'' ts⇩s⇩b_j]
have "weak_sharing_consistent 𝒪⇩j sb⇩j".
with weak_sharing_consistent_append [of 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
have "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) suspends⇩j"
by (auto simp add: suspends⇩j)
with split_suspends⇩j
have weak_consis: "weak_sharing_consistent (acquired True ?take_sb⇩j 𝒪⇩j) ys"
by (simp add: weak_sharing_consistent_append)
from all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "all_acquired ys ⊆ all_acquired sb⇩j"
apply (clarsimp)
apply (clarsimp simp add: suspends⇩j [symmetric] split_suspends⇩j all_acquired_append)
done
with a_notin acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "a' ∉ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j ∪ all_acquired ys"
by auto
from read_only_share_unowned [OF weak_consis this a'_ro]
have "a' ∈ read_only (share ?drop_sb 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)" .
with a'_not_ro have False
by auto
}
thus ?thesis by blast
qed
moreover
from A_unaquired_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: Let_def)
moreover
from A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto simp add: Let_def dest: all_shared_acquired_in)
moreover note a'_in
ultimately
show False
by auto
qed
}
thus ?thesis
by (auto simp add: Let_def)
qed
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W]) "
by (auto simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
proof (cases "i⇩1=i")
case True
with i⇩1_j have i_j: "i≠j"
by simp
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence j_bound'': "j < length (map owned ts⇩s⇩b)"
by simp
from ts_j i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i_bound j_bound' i_j ts⇩s⇩b_i ts_j']
have "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb = {}".
with ts_i⇩1 True i_bound show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb' outstanding_refs_append
acquired_takeWhile_non_volatile_Write⇩s⇩b)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b')
show ?thesis
proof (cases "j=i")
case True
from i⇩1_bound'
have i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by simp
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
have "(𝒪⇩s⇩b ∪ all_acquired sb) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}".
moreover
from A_unused_by_others [rule_format, OF _ False [symmetric]] False ts_i⇩1 i⇩1_bound
have "A ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
by (auto simp add: Let_def ts⇩s⇩b')
ultimately
show ?thesis
using ts_j True ts⇩s⇩b'
by (auto simp add: i_bound ts⇩s⇩b' 𝒪⇩s⇩b' sb' all_acquired_append)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" .
qed
qed
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
moreover
from A_no_read_only_reads_by_others [rule_format, OF _ neq_n_i [symmetric]] n_bound' nth'
have "A ∩ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
by auto
ultimately
show ?thesis
using True ts⇩s⇩b_i nth' mth n_bound' m_bound'
by (auto simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' all_acquired_append)
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
note read_only_reads_unowned [OF i_bound m_bound' neq_m_i [symmetric] ts⇩s⇩b_i mth']
then show ?thesis
using True neq_m_i ts⇩s⇩b_i nth mth n_bound' m_bound'
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (clarsimp simp add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append ts⇩s⇩b' sb' 𝒪⇩s⇩b')+
done
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have "∀j<length ts⇩s⇩b. i ≠ j ⟶
(let (p⇩j, is⇩j,θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j) = ts⇩s⇩b ! j
in (𝒪⇩s⇩b ∪ all_acquired sb') ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {})"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume neq_i_j: "i ≠ j"
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b ! j = (p⇩j, is⇩j, θ⇩j, sb⇩j, 𝒟⇩j, 𝒪⇩j,ℛ⇩j)"
have "(𝒪⇩s⇩b ∪ all_acquired sb') ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
proof -
{
fix a'
assume a'_in_i: "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb')"
assume a'_in_j: "a' ∈ (𝒪⇩j ∪ all_acquired sb⇩j)"
have False
proof -
from a'_in_i have "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb) ∨ a' ∈ A"
by (simp add: sb' all_acquired_append)
then show False
proof
assume "a' ∈ (𝒪⇩s⇩b ∪ all_acquired sb)"
with ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j] a'_in_j
show ?thesis
by auto
next
assume "a' ∈ A"
moreover
have j_bound': "j < length (map owned ts⇩s⇩b)"
using j_bound by auto
from A_unowned_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
obtain "A ∩ acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j = {}" and
"A ∩ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) = {}"
by (auto simp add: Let_def)
moreover
from A_unaquired_by_others [rule_format, OF _ neq_i_j] ts⇩s⇩b_j j_bound
have "A ∩ all_acquired sb⇩j = {}"
by auto
ultimately
show ?thesis
using a'_in_j
by (auto dest: all_shared_acquired_in)
qed
qed
}
then show ?thesis by auto
qed
}
then show ?thesis by (fastforce simp add: Let_def)
qed
from ownership_distinct_nth_update [OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb')
qed
qed
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
with valid_write_sops [OF i_bound ts⇩s⇩b_i]
valid_implies_valid_prog_hd [OF i_bound ts⇩s⇩b_i valid]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b (sb@[Ghost⇩s⇩b A L R W]))
(sb@ [Ghost⇩s⇩b A L R W])"
apply -
apply (rule history_consistent_appendI)
apply (auto simp add: hd_prog_append_Ghost⇩s⇩b)
done
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' θ⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
from reads_consistent_snoc_Ghost⇩s⇩b [OF this]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W])".
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have consis': "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb".
from A_shared_owned
have "A ⊆ dom (share ?drop_sb 𝒮) ∪ acquired True sb 𝒪⇩s⇩b"
by (simp add: sharing_consistent_append acquired_takeWhile_non_volatile_Write⇩s⇩b)
moreover have "dom (share ?drop_sb 𝒮) ⊆ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b)"
proof
fix a'
assume a'_in: "a' ∈ dom (share ?drop_sb 𝒮)"
from share_unshared_in [OF a'_in]
show "a' ∈ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b)"
proof
assume "a' ∈ dom (share ?drop_sb Map.empty)"
from share_mono_in [OF this] share_append [of ?take_sb ?drop_sb]
have "a' ∈ dom (share sb 𝒮⇩s⇩b)"
by auto
thus ?thesis
by simp
next
assume "a' ∈ dom 𝒮 ∧ a' ∉ all_unshared ?drop_sb"
thus ?thesis by auto
qed
qed
ultimately
have A_subset: "A ⊆ dom 𝒮 ∪ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
by auto
have "A ⊆ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
proof -
{
fix x
assume x_A: "x ∈ A"
have "x ∈ dom (share sb 𝒮⇩s⇩b) ∪ acquired True sb 𝒪⇩s⇩b"
proof -
{
assume "x ∈ dom 𝒮"
from share_all_until_volatile_write_share_acquired [OF ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b›
i_bound ts⇩s⇩b_i this [simplified 𝒮]]
A_unowned_by_others x_A
have ?thesis
by (fastforce simp add: Let_def)
}
with A_subset show ?thesis using x_A by auto
qed
}
thus ?thesis by blast
qed
with consis' L_subset A_R R_acq
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W])"
by (simp add: sharing_consistent_append acquired_takeWhile_non_volatile_Write⇩s⇩b)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' sb' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b'" by (simp add: "is⇩s⇩b")
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps (sb @ [Ghost⇩s⇩b A L R W])"
by (auto simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ read_tmps (sb @ [Ghost⇩s⇩b A L R W]) ={}"
by (auto simp add: read_tmps_append "is⇩s⇩b")
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b' sb')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i]
obtain
valid_store_sops': "∀sop∈store_sops is⇩s⇩b'. valid_sop sop"
by (auto simp add: "is⇩s⇩b")
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have valid_write_sops': "∀sop∈write_sops (sb@ [Ghost⇩s⇩b A L R W]).
valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound valid_write_sops' valid_store_sops']
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
obtain
dd_is: "data_dependency_consistent_instrs (dom θ⇩s⇩b') is⇩s⇩b'"
by (auto simp add: "is⇩s⇩b" θ⇩s⇩b')
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ ⋃(fst ` write_sops (sb@ [Ghost⇩s⇩b A L R W])) ={}"
by (auto simp add: write_sops_append "is⇩s⇩b")
from valid_data_dependency_nth_update [OF i_bound dd_is this]
show ?thesis by (simp add: ts⇩s⇩b' sb')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b' ∩ dom θ⇩s⇩b = {}"
by (auto simp add: "is⇩s⇩b")
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' θ⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Ghost⇩s⇩b A L R W])= {}"
by (auto simp add: outstanding_refs_append)
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb' 𝒟⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b' (sb@[Ghost⇩s⇩b A L R W])"
by (auto simp: causal_program_history_Ghost "is⇩s⇩b")
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b (sb @ [Ghost⇩s⇩b A L R W]) = p⇩s⇩b"
by (simp add: last_prog_append_Ghost⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b' sb')
qed
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is =Ghost A L R W# is⇩s⇩b'"
by (simp add: "is⇩s⇩b")
with suspends_empty ts_i
have ts_i: "ts!i = (p⇩s⇩b, Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b,(), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
from direct_memop_step.Ghost
have "(Ghost A L R W# is⇩s⇩b',
θ⇩s⇩b, (),m, 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b, 𝒮) →
(is⇩s⇩b',
θ⇩s⇩b, (), m, 𝒟, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b),
𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
from direct_computation.concurrent_step.Memop [OF i_bound' ts_i this]
have "(ts, m, 𝒮) ⇒⇩d
(ts[i := (p⇩s⇩b, is⇩s⇩b',
θ⇩s⇩b, (),𝒟, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
m,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
moreover
from suspend_nothing
have suspend_nothing': "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = []"
by (simp add: sb')
have all_shared_A: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_A: "x ∈ A"
have False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
from A_unaquired_by_others [rule_format, OF _ neq_i_j] jth j_bound
have "A ∩ all_acquired sb⇩j = {}" by auto
moreover
from A_unowned_by_others [rule_format, OF _ neq_i_j] jth j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto dest: all_shared_acquired_in)
ultimately
show False
using x_A x_shared
by blast
qed
}
thus ?thesis by blast
qed
hence all_shared_L: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
using L_subset by blast
have all_shared_A: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ A = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i ≠ j"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_A: "x ∈ A"
have False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
from A_unaquired_by_others [rule_format, OF _ neq_i_j] jth j_bound
have "A ∩ all_acquired sb⇩j = {}" by auto
moreover
from A_unowned_by_others [rule_format, OF _ neq_i_j] jth j_bound
have "A ∩ 𝒪⇩j = {}"
by (auto dest: all_shared_acquired_in)
ultimately
show False
using x_A x_shared
by blast
qed
}
thus ?thesis by blast
qed
hence all_shared_L: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ L = {}"
using L_subset by blast
have all_unshared_R: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_unshared: "x ∈ all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof -
from unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_unshared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_unshared sb⇩j"
using all_unshared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
ultimately
show False
using R_acq x_R x_unshared acquired_all_acquired [of True sb 𝒪⇩s⇩b]
by blast
qed
}
thus ?thesis by blast
qed
have all_acquired_R: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i ≠ j"
assume x_acq: "x ∈ all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof -
from x_acq have "x ∈ all_acquired sb⇩j"
using all_acquired_append [of "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
"dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
ultimately
show False
using R_acq x_R acquired_all_acquired [of True sb 𝒪⇩s⇩b]
by blast
qed
}
thus ?thesis by blast
qed
have all_shared_R: "∀j p is 𝒪 ℛ 𝒟 θ sb. j < length ts⇩s⇩b ⟶ i ≠ j ⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪,ℛ) ⟶
all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∩ R = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i ≠ j"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R: "x ∈ R"
have False
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "all_shared sb⇩j ⊆ all_acquired sb⇩j ∪ 𝒪⇩j".
moreover have "all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ⊆ all_shared sb⇩j"
using all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
moreover
note ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
ultimately
show False
using R_acq x_R x_shared acquired_all_acquired [of True sb 𝒪⇩s⇩b]
by blast
qed
}
thus ?thesis by blast
qed
note share_commute =
share_all_until_volatile_write_append_Ghost⇩s⇩b [OF True ‹ownership_distinct ts⇩s⇩b› ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b›
i_bound ts⇩s⇩b_i all_shared_L all_shared_A all_acquired_R all_unshared_R all_shared_R]
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Ghost⇩s⇩b A L R W]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "∀a ∈ R. (a ∈ (dom (share sb 𝒮⇩s⇩b)) ) = (a ∈ dom 𝒮)"
proof -
{
fix a
assume a_R: "a ∈ R"
have "(a ∈ (dom (share sb 𝒮⇩s⇩b)) ) = (a ∈ dom 𝒮)"
proof -
from a_R R_acq acquired_all_acquired [of True sb 𝒪⇩s⇩b]
have "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb"
by auto
from share_all_until_volatile_write_thread_local' [OF ownership_distinct_ts⇩s⇩b sharing_consis_ts⇩s⇩b i_bound ts⇩s⇩b_i this] suspend_nothing
show ?thesis by (auto simp add: domIff 𝒮)
qed
}
then show ?thesis by auto
qed
from augment_rels_shared_exchange [OF this]
have rel_commute:
"augment_rels (dom 𝒮) R (release sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b) =
release (sb @ [Ghost⇩s⇩b A L R W]) (dom 𝒮⇩s⇩b') ℛ⇩s⇩b"
by (clarsimp simp add: release_append 𝒮⇩s⇩b')
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼
(ts[i := (p⇩s⇩b,is⇩s⇩b',
θ⇩s⇩b,(), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R,
augment_rels (dom 𝒮) R (release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b))],
m,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply (rule sim_config.intros)
apply (simp add: m ts⇩s⇩b' 𝒪⇩s⇩b' sb' θ⇩s⇩b' flush_all_until_volatile_write_append_Ghost_commute [OF i_bound ts⇩s⇩b_i])
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' θ⇩s⇩b' share_commute)
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i True 𝒟'
apply (clarsimp simp add: Let_def nth_list_update
outstanding_refs_conv ts⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' sb' 𝒟⇩s⇩b' suspend_nothing' flush_all rel_commute
acquired_append split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_sops'
valid_dd' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b' ℛ⇩s⇩b'
by auto
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' A'' L'' R'' W'' sop' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
apply (auto)
subgoal for y ys
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends: "suspends = Write⇩s⇩b True a' sop' v' A'' L'' R'' W''# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
have "Write⇩s⇩b True a' sop' v' A'' L'' R'' W''∈ set sb"
by (subst sb_split) auto
note drop_app = dropWhile_append1
[OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified]
from takeWhile_append1 [where P="Not ∘ is_volatile_Write⇩s⇩b", OF r_in] volatile_r
have takeWhile_app:
"(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Ghost⇩s⇩b A L R W])) = (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by simp
note share_commute = share_all_until_volatile_write_append_Ghost⇩s⇩b' [OF False i_bound ts⇩s⇩b_i]
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Ghost⇩s⇩b A L R W]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b',m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_all_until_volatile_write_append_Ghost_commute [OF i_bound ts⇩s⇩b_i] ts⇩s⇩b' 𝒪⇩s⇩b' θ⇩s⇩b' sb')
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' ts⇩s⇩b' sb' 𝒪⇩s⇩b' θ⇩s⇩b' share_commute)
using leq
apply (simp add: ts⇩s⇩b')
using i_bound i_bound' ts_sim ts_i is_sim 𝒟'
apply (clarsimp simp add: Let_def nth_list_update is_sim drop_app
read_tmps_append suspends
prog_instrs_append_Ghost⇩s⇩b instrs_append_Ghost⇩s⇩b hd_prog_append_Ghost⇩s⇩b
drop "is⇩s⇩b" ts⇩s⇩b' sb' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b' θ⇩s⇩b' 𝒟⇩s⇩b' takeWhile_app split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' valid_dd'
valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid' m⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply )
qed
qed
next
case (StoreBuffer i p⇩s⇩b "is⇩s⇩b" θ⇩s⇩b sb 𝒟⇩s⇩b 𝒪⇩s⇩b ℛ⇩s⇩b sb' 𝒪⇩s⇩b' ℛ⇩s⇩b')
then obtain
ts⇩s⇩b': "ts⇩s⇩b' = ts⇩s⇩b[i := (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b, sb', 𝒟⇩s⇩b, 𝒪⇩s⇩b',ℛ⇩s⇩b')]" and
i_bound: "i < length ts⇩s⇩b" and
ts⇩s⇩b_i: "ts⇩s⇩b ! i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b,sb, 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)" and
flush: "(m⇩s⇩b,sb,𝒪⇩s⇩b,ℛ⇩s⇩b,𝒮⇩s⇩b) →⇩f
(m⇩s⇩b',sb',𝒪⇩s⇩b',ℛ⇩s⇩b',𝒮⇩s⇩b')"
by auto
from sim obtain
m: "m = flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b" and
𝒮: "𝒮 = share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b" and
leq: "length ts⇩s⇩b = length ts" and
ts_sim: "∀i<length ts⇩s⇩b.
let (p, is⇩s⇩b, θ, sb,𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ) = ts⇩s⇩b ! i;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends ∧
𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts ! i =
(hd_prog p suspends,
is,
θ |` (dom θ - read_tmps suspends), (),
𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b,
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮⇩s⇩b) ℛ)"
by cases blast
from i_bound leq have i_bound': "i < length ts"
by auto
have split_sb: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
(is "sb = ?take_sb@?drop_sb")
by simp
from ts_sim [rule_format, OF i_bound] ts⇩s⇩b_i obtain suspends "is" 𝒟 where
suspends: "suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb" and
is_sim: "instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends" and
𝒟: "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {})" and
ts_i: "ts ! i =
(hd_prog p⇩s⇩b suspends, is,
θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps suspends), (),𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (auto simp add: Let_def)
from flush_step_preserves_valid [OF i_bound ts⇩s⇩b_i flush valid]
have valid': "valid ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
from flush obtain r where sb: "sb=r#sb'"
by (cases) auto
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
then
have hist_consis': "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb') sb'"
by (auto simp add: sb intro: history_consistent_hd_prog
split: memref.splits option.splits)
from valid_history_nth_update [OF i_bound this]
have valid_hist': "valid_history program_step ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have dist_sb': "distinct_read_tmps sb'"
by (simp add: sb split: memref.splits)
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b".
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct_nth_update [OF i_bound dist_sb']
show "read_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b ∩ read_tmps sb' = {}"
by (auto simp add: sb split: memref.splits)
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
qed
from load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b ∩ ⋃(fst ` write_sops sb') = {}"
by (auto simp add: sb split: memref.splits)
from valid_data_dependency_nth_update
[OF i_bound data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i] this]
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
from valid_store_sops [OF i_bound ts⇩s⇩b_i] valid_write_sops [OF i_bound ts⇩s⇩b_i]
valid_sops_nth_update [OF i_bound]
have valid_sops': "valid_sops ts⇩s⇩b'"
by (cases r) (auto simp add: sb ts⇩s⇩b')
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
have "load_tmps is⇩s⇩b ∩ dom θ⇩s⇩b = {}".
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b sb' = {}"
by (auto simp add: sb split: if_split_asm)
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b' sb)
qed
show ?thesis
proof (cases r)
case (Write⇩s⇩b volatile a sop v A L R W)
from flush this
have m⇩s⇩b': "m⇩s⇩b' = (m⇩s⇩b(a := v))"
by cases (auto simp add: sb)
have non_volatile_owned: "¬ volatile ⟶ a ∈ 𝒪⇩s⇩b"
proof (cases volatile)
case True thus ?thesis by simp
next
case False
with outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "a ∈ 𝒪⇩s⇩b"
by (simp add: sb Write⇩s⇩b)
thus ?thesis by simp
qed
have a_unowned_by_others:
"∀j < length ts⇩s⇩b. i ≠ j ⟶ (let (_,_,_,sb⇩j,_,𝒪⇩j,_) = ts⇩s⇩b ! j in
a ∉ 𝒪⇩j ∪ all_acquired sb⇩j)"
proof (unfold Let_def, clarify del: notI)
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume neq: "i ≠ j"
assume ts_j: "ts⇩s⇩b ! j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
proof (cases volatile)
case True
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound neq
ts⇩s⇩b_i ts_j]
show ?thesis
by (simp add: sb Write⇩s⇩b True)
next
case False
with non_volatile_owned
have "a ∈ 𝒪⇩s⇩b"
by simp
with ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i ts_j]
show ?thesis
by blast
qed
qed
from valid_reads [OF i_bound ts⇩s⇩b_i]
have reads_consis: "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
{
fix j
fix p⇩j is⇩s⇩b⇩j 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j=(p⇩j,is⇩s⇩b⇩j,θ⇩j,sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i≠j"
have "a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
proof
assume "a ∈ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
hence "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
by (simp add: outstanding_refs_is_non_volatile_Write⇩s⇩b_takeWhile_conv)
hence "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
using outstanding_refs_append [of _ "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
by auto
with non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound ts⇩s⇩b_j]]
have "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with a_unowned_by_others [rule_format, OF j_bound neq_i_j] ts⇩s⇩b_j
show False
by auto
qed
}
note a_notin_others = this
from a_notin_others
have a_notin_others':
"∀j < length ts⇩s⇩b. i ≠ j ⟶
(let (_,_,_,sb⇩j,_,_,_) = ts⇩s⇩b!j in a ∉ outstanding_refs is_Write⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j))"
by (fastforce simp add: Let_def)
obtain D f where sop: "sop=(D,f)" by (cases sop) auto
from valid_history [OF i_bound ts⇩s⇩b_i] sop sb Write⇩s⇩b
obtain D_tmps: "D ⊆ dom θ⇩s⇩b" and f_v: "f θ⇩s⇩b = v" and
D_sb': "D ∩ read_tmps sb' = {}"
by auto
let ?θ = "(θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps sb'))"
from D_tmps D_sb'
have D_tmps': "D ⊆ dom ?θ"
by auto
from valid_write_sops [OF i_bound ts⇩s⇩b_i, rule_format, of sop]
have "valid_sop sop"
by (auto simp add: sb Write⇩s⇩b)
from this [simplified sop]
interpret valid_sop "(D,f)" .
from D_tmps D_sb'
have "((dom θ⇩s⇩b - read_tmps sb') ∩ D) = D"
by blast
with valid_sop [OF refl D_tmps] valid_sop [OF refl D_tmps'] f_v
have f_v': "f ?θ = v"
by auto
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b sb'"
by (simp add: sb Write⇩s⇩b causal_program_history_def)
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb Write⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
show ?thesis
proof (cases volatile)
case True
note volatile = this
from flush Write⇩s⇩b volatile
obtain
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b ∪ A - R" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'= 𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L" and
ℛ⇩s⇩b': "ℛ⇩s⇩b' = Map.empty"
by cases (auto simp add: sb)
from sharing_consis [OF i_bound ts⇩s⇩b_i]
obtain
A_shared_owned: "A ⊆ dom 𝒮⇩s⇩b ∪ 𝒪⇩s⇩b" and
L_subset: "L ⊆ A" and
A_R: "A ∩ R = {}" and
R_owned: "R ⊆ 𝒪⇩s⇩b"
by (clarsimp simp add: sb Write⇩s⇩b volatile)
from sb Write⇩s⇩b True have take_empty: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
from sb Write⇩s⇩b True have suspend_all: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
hence suspends_all: "suspends = sb"
by (simp add: suspends)
from is_sim
have is_sim: "Write True a (D, f) A L R W# instrs sb' @ is⇩s⇩b = is @ prog_instrs sb'"
by (simp add: True Write⇩s⇩b suspends_all sb sop)
from valid_program_history [OF i_bound ts⇩s⇩b_i]
interpret causal_program_history "is⇩s⇩b" sb .
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have last_prog: "last_prog p⇩s⇩b sb = p⇩s⇩b".
from causal_program_history [of "[Write⇩s⇩b True a (D, f) v A L R W]" sb'] is_sim
obtain is' where
"is": "is = Write True a (D, f) A L R W# is'" and
is'_sim: "instrs sb'@is⇩s⇩b = is' @ prog_instrs sb'"
by (auto simp add: sb Write⇩s⇩b volatile sop)
from causal_program_history have
causal_program_history_sb': "causal_program_history is⇩s⇩b sb'"
apply -
apply (rule causal_program_history.intro)
apply (auto simp add: sb Write⇩s⇩b)
done
from ts_i have ts_i: "ts ! i =
(hd_prog p⇩s⇩b sb', Write True a (D, f) A L R W# is', ?θ, (), 𝒟,acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (simp add: suspends_all sb Write⇩s⇩b "is")
let ?ts' = "ts[i := (hd_prog p⇩s⇩b sb', is', ?θ, (), True, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R,
Map.empty)]"
from i_bound' have ts'_i: "?ts'!i = (hd_prog p⇩s⇩b sb', is', ?θ, (),True, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R,Map.empty)"
by simp
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have a_not_ro: "a ∉ read_only 𝒮⇩s⇩b"
by (clarsimp simp add: sb Write⇩s⇩b volatile)
{
fix j
fix p⇩j is⇩s⇩b⇩j 𝒪⇩j ℛ⇩j 𝒟⇩s⇩b⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j=(p⇩j,is⇩s⇩b⇩j,θ⇩j,sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i≠j"
have "a ∉ unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) {}"
proof
let ?take_sb⇩j = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
let ?drop_sb⇩j = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
assume a_in: "a ∈ unforwarded_non_volatile_reads ?drop_sb⇩j {}"
from a_unowned_by_others [rule_format, OF j_bound neq_i_j] ts⇩s⇩b_j
obtain a_unowned: "a ∉ 𝒪⇩j" and a_unacq: "a ∉ all_acquired sb⇩j"
by auto
with all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have a_unacq_take: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by (auto simp add: )
note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound ts⇩s⇩b_j]
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j" .
note consis_j = sharing_consis [OF j_bound ts⇩s⇩b_j]
with sharing_consistent_append [of 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j ?drop_sb⇩j]
obtain consis_take_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j ?take_sb⇩j" and
consis_drop_j: "sharing_consistent (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by auto
from in_unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b [OF a_in]
have a_in': "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j".
note reads_consis_j = valid_reads [OF j_bound ts⇩s⇩b_j]
from reads_consistent_drop [OF this]
have reads_consis_drop_j:
"reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) (flush ?take_sb⇩j m⇩s⇩b) ?drop_sb⇩j".
from read_only_share_all_shared [of a ?take_sb⇩j 𝒮⇩s⇩b] a_not_ro
all_shared_acquired_or_owned [OF consis_take_j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] a_unowned a_unacq
have a_not_ro_j: "a ∉ read_only (share ?take_sb⇩j 𝒮⇩s⇩b)"
by auto
from ts_sim [rule_format, OF j_bound] ts⇩s⇩b_j j_bound
obtain suspends⇩j "is⇩j" 𝒟⇩j ℛ⇩j where
suspends⇩j: "suspends⇩j = ?drop_sb⇩j" and
is⇩j: "instrs suspends⇩j @ is⇩s⇩b⇩j = is⇩j @ prog_instrs suspends⇩j" and
𝒟⇩j: "𝒟⇩s⇩b⇩j = (𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ≠ {})" and
ts⇩j: "ts!j = (hd_prog p⇩j suspends⇩j, is⇩j,
θ⇩j |` (dom θ⇩j - read_tmps suspends⇩j),(),
𝒟⇩j, acquired True ?take_sb⇩j 𝒪⇩j,ℛ⇩j)"
by (auto simp: Let_def)
from valid_last_prog [OF j_bound ts⇩s⇩b_j] have last_prog: "last_prog p⇩j sb⇩j = p⇩j".
from j_bound i_bound' leq have j_bound_ts': "j < length ts"
by simp
from read_only_read_acquired_unforwarded_acquire_witness [OF nvo_drop_j consis_drop_j
a_not_ro_j a_unacq_take a_in]
have False
proof
assume "∃sop a' v ys zs A L R W.
?drop_sb⇩j = ys @ Write⇩s⇩b True a' sop v A L R W # zs ∧ a ∈ A ∧
a ∉ outstanding_refs is_Write⇩s⇩b ys ∧ a'≠a"
with suspends⇩j
obtain a' sop' v' ys zs' A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Write⇩s⇩b True a' sop' v' A' L' R' W'# zs'" (is "suspends⇩j=?suspends") and
a_A': "a ∈ A'" and
no_write: "a ∉ outstanding_refs is_Write⇩s⇩b (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (auto simp add: outstanding_refs_append)
from last_prog
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from sharing_consis [OF j_bound ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
from valid_program_history [OF j_bound ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_reads [OF j_bound ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
m (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Write⇩s⇩b True a' sop' v' A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']" and sb'="zs'", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j] ts⇩j [simplified split_suspends⇩j]
refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs' @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs'" and
steps_ys: "(ts, m, 𝒮) ⇒⇩d⇧*
(ts[j:=(last_prog
(hd_prog p⇩j (Write⇩s⇩b True a' sop' v' A' L' R' W'# zs')) (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']),
is⇩j',
θ⇩j |` (dom θ⇩j - read_tmps zs'),
(), True, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) m,
share (ys@[Write⇩s⇩b True a' sop' v' A' L' R' W']) 𝒮)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j ts_i
have ts_ys_i: "?ts_ys!i = (hd_prog p⇩s⇩b sb', Write True a (D, f) A L R W# is', ?θ, (), 𝒟,
acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = steps_ys
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
with safe_delayedE [OF safe i_bound_ys ts_ys_i]
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def sb)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
show False
by (auto simp add: Let_def)
next
assume "∃A L R W ys zs. ?drop_sb⇩j = ys @ Ghost⇩s⇩b A L R W# zs ∧ a ∈ A ∧ a ∉ outstanding_refs is_Write⇩s⇩b ys"
with suspends⇩j
obtain ys zs' A' L' R' W' where
split_suspends⇩j: "suspends⇩j = ys @ Ghost⇩s⇩b A' L' R' W'# zs'" (is "suspends⇩j=?suspends") and
a_A': "a ∈ A'" and
no_write: "a ∉ outstanding_refs is_Write⇩s⇩b (ys @ [Ghost⇩s⇩b A' L' R' W'])"
by (auto simp add: outstanding_refs_append)
from last_prog
have lp: "last_prog p⇩j suspends⇩j = p⇩j"
apply -
apply (rule last_prog_same_append [where sb="?take_sb⇩j"])
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from valid_program_history [OF j_bound ts⇩s⇩b_j]
have "causal_program_history is⇩s⇩b⇩j sb⇩j".
then have cph: "causal_program_history is⇩s⇩b⇩j ?suspends"
apply -
apply (rule causal_program_history_suffix [where sb="?take_sb⇩j"] )
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp add: split_suspends⇩j)
done
from valid_reads [OF j_bound ts⇩s⇩b_j]
have reads_consis_j: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j".
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
j_bound ts⇩s⇩b_j this]
have reads_consis_m_j: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j) m suspends⇩j"
by (simp add: m suspends⇩j)
hence reads_consis_ys: "reads_consistent True (acquired True ?take_sb⇩j 𝒪⇩j)
m (ys@[Ghost⇩s⇩b A' L' R' W'])"
by (simp add: split_suspends⇩j reads_consistent_append)
from valid_write_sops [OF j_bound ts⇩s⇩b_j]
have "∀sop∈write_sops (?take_sb⇩j@?suspends). valid_sop sop"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain valid_sops_take: "∀sop∈write_sops ?take_sb⇩j. valid_sop sop" and
valid_sops_drop: "∀sop∈write_sops (ys@[Ghost⇩s⇩b A' L' R' W']). valid_sop sop"
apply (simp only: write_sops_append)
apply auto
done
from read_tmps_distinct [OF j_bound ts⇩s⇩b_j]
have "distinct_read_tmps (?take_sb⇩j@suspends⇩j)"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
then obtain
read_tmps_take_drop: "read_tmps ?take_sb⇩j ∩ read_tmps suspends⇩j = {}" and
distinct_read_tmps_drop: "distinct_read_tmps suspends⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply (simp only: distinct_read_tmps_append)
done
from valid_history [OF j_bound ts⇩s⇩b_j]
have h_consis:
"history_consistent θ⇩j (hd_prog p⇩j (?take_sb⇩j@suspends⇩j)) (?take_sb⇩j@suspends⇩j)"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
apply simp
done
from sharing_consis [OF j_bound ts⇩s⇩b_j]
have sharing_consis_j: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
then have A'_R': "A' ∩ R' = {}"
by (simp add: sharing_consistent_append [of _ _ ?take_sb⇩j ?drop_sb⇩j, simplified]
suspends⇩j [symmetric] split_suspends⇩j sharing_consistent_append)
have last_prog_hd_prog: "last_prog (hd_prog p⇩j sb⇩j) ?take_sb⇩j = (hd_prog p⇩j suspends⇩j)"
proof -
from last_prog have "last_prog p⇩j (?take_sb⇩j@?drop_sb⇩j) = p⇩j"
by simp
from last_prog_hd_prog_append' [OF h_consis] this
have "last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j = hd_prog p⇩j suspends⇩j"
by (simp only: split_suspends⇩j [symmetric] suspends⇩j)
moreover
have "last_prog (hd_prog p⇩j (?take_sb⇩j @ suspends⇩j)) ?take_sb⇩j =
last_prog (hd_prog p⇩j suspends⇩j) ?take_sb⇩j"
apply (simp only: split_suspends⇩j [symmetric] suspends⇩j)
by (rule last_prog_hd_prog_append)
ultimately show ?thesis
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
qed
from history_consistent_appendD [OF valid_sops_take read_tmps_take_drop
h_consis] last_prog_hd_prog
have hist_consis': "history_consistent θ⇩j (hd_prog p⇩j suspends⇩j) suspends⇩j"
by (simp add: split_suspends⇩j [symmetric] suspends⇩j)
from reads_consistent_drop_volatile_writes_no_volatile_reads
[OF reads_consis_j]
have no_vol_read: "outstanding_refs is_volatile_Read⇩s⇩b
(ys@[Ghost⇩s⇩b A' L' R' W']) = {}"
by (auto simp add: outstanding_refs_append suspends⇩j [symmetric]
split_suspends⇩j )
have acq_simp:
"acquired True (ys @ [Ghost⇩s⇩b A' L' R' W'])
(acquired True ?take_sb⇩j 𝒪⇩j) =
acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R'"
by (simp add: acquired_append)
from flush_store_buffer_append [where sb="ys@[Ghost⇩s⇩b A' L' R' W']" and sb'="zs'", simplified,
OF j_bound_ts' is⇩j [simplified split_suspends⇩j] cph [simplified suspends⇩j]
ts⇩j [simplified split_suspends⇩j] refl lp [simplified split_suspends⇩j] reads_consis_ys
hist_consis' [simplified split_suspends⇩j] valid_sops_drop
distinct_read_tmps_drop [simplified split_suspends⇩j]
no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_vol_read], where
𝒮="𝒮"]
obtain is⇩j' ℛ⇩j' where
is⇩j': "instrs zs' @ is⇩s⇩b⇩j = is⇩j' @ prog_instrs zs'" and
steps_ys: "(ts, m,𝒮) ⇒⇩d⇧*
(ts[j:=(last_prog
(hd_prog p⇩j (Ghost⇩s⇩b A' L' R' W'# zs')) (ys@[Ghost⇩s⇩b A' L' R' W']),
is⇩j',
θ⇩j |` (dom θ⇩j - read_tmps zs'),
(),
𝒟⇩j ∨ outstanding_refs is_volatile_Write⇩s⇩b ys ≠ {}, acquired True ys (acquired True ?take_sb⇩j 𝒪⇩j) ∪ A' - R',ℛ⇩j')],
flush (ys@[Ghost⇩s⇩b A' L' R' W']) m, share (ys@[Ghost⇩s⇩b A' L' R' W']) 𝒮)"
(is "(_,_,_) ⇒⇩d⇧* (?ts_ys,?m_ys,?shared_ys)")
by (auto simp add: acquired_append outstanding_refs_append)
from i_bound' have i_bound_ys: "i < length ?ts_ys"
by auto
from i_bound' neq_i_j ts_i
have ts_ys_i: "?ts_ys!i = (hd_prog p⇩s⇩b sb', Write True a (D, f) A L R W# is', ?θ, (), 𝒟,
acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by simp
note conflict_computation = steps_ys
from safe_reach_safe_rtrancl [OF safe_reach conflict_computation]
have safe: "safe_delayed (?ts_ys,?m_ys,?shared_ys)".
with safe_delayedE [OF safe i_bound_ys ts_ys_i]
have a_unowned:
"∀j < length ?ts_ys. i≠j ⟶ (let (𝒪⇩j) = map owned ?ts_ys!j in a ∉ 𝒪⇩j)"
apply cases
apply (auto simp add: Let_def sb)
done
from a_A' a_unowned [rule_format, of j] neq_i_j j_bound leq A'_R'
show False
by (auto simp add: Let_def)
qed
then show False
by simp
qed
}
note a_notin_unforwarded_non_volatile_reads_drop = this
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "reads_consistent False 𝒪⇩j m⇩s⇩b' sb⇩j"
proof (cases "i=j")
case True
from reads_consis ts_j j_bound sb show ?thesis
by (clarsimp simp add: True m⇩s⇩b' Write⇩s⇩b ts⇩s⇩b' 𝒪⇩s⇩b' volatile reads_consistent_pending_write_antimono)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
moreover from ts_j False have ts_j': "ts⇩s⇩b ! j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
using j_bound by (simp add: ts⇩s⇩b')
ultimately have consis_m: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j"
by (rule valid_reads)
from a_unowned_by_others [rule_format, OF j_bound' False] ts_j'
have a_unowned:"a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
by simp
let ?take_sb⇩j = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
let ?drop_sb⇩j = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
from a_unowned acquired_reads_all_acquired [of True ?take_sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have a_not_acq_reads: "a ∉ acquired_reads True ?take_sb⇩j 𝒪⇩j"
by auto
moreover
note a_unfw= a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
ultimately
show ?thesis
using reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop [where W="{}" and
A="unforwarded_non_volatile_reads ?drop_sb⇩j {} ∪ acquired_reads True ?take_sb⇩j 𝒪⇩j" and
m'= "(m⇩s⇩b(a:=v))", OF _ _ _ consis_m]
by (fastforce simp add: m⇩s⇩b')
qed
qed
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof
fix j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j p⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts⇩s⇩b'_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_owned_or_read_only False 𝒮⇩s⇩b' 𝒪⇩j sb⇩j"
proof (cases "j=i")
case True
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False
(𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪⇩s⇩b ∪ A - R) sb'"
by (auto simp add: sb Write⇩s⇩b volatile non_volatile_owned_or_read_only_pending_write_antimono)
then show ?thesis
using True i_bound ts⇩s⇩b'_j
by (auto simp add: ts⇩s⇩b' 𝒮⇩s⇩b' sb 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with ts⇩s⇩b'_j False i_bound
have ts⇩s⇩b_j: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' ts⇩s⇩b_j]
from read_only_unowned [OF i_bound ts⇩s⇩b_i] R_owned
have "R ∩ read_only 𝒮⇩s⇩b = {}"
by auto
with read_only_reads_unowned [OF j_bound' i_bound False ts⇩s⇩b_j ts⇩s⇩b_i] L_subset
have "∀a∈read_only_reads
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j).
a ∈ read_only 𝒮⇩s⇩b ⟶ a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (auto simp add: in_read_only_convs sb Write⇩s⇩b volatile)
from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
have "non_volatile_owned_or_read_only False (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j".
thus ?thesis by (simp add: 𝒮⇩s⇩b')
qed
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j, xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
proof (cases "i⇩1=i")
case True
from i⇩1_j True have neq_i_j: "i≠j"
by auto
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j neq_i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound' neq_i_j
ts⇩s⇩b_i ts_j'] ts_i⇩1 i_bound ts⇩s⇩b_i True show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Write⇩s⇩b volatile)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b' sb)
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by auto
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b' sb)
show ?thesis
proof (cases "j=i")
case True
from outstanding_volatile_writes_unowned_by_others [OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i ]
have "(𝒪⇩s⇩b ∪ all_acquired sb) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}".
then show ?thesis
using True i⇩1_i ts_j ts⇩s⇩b_i i_bound
by (auto simp add: sb Write⇩s⇩b volatile ts⇩s⇩b' 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" .
qed
qed
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
then
show ?thesis
using True ts⇩s⇩b_i neq_n_i nth mth n_bound' m_bound' L_subset
by (auto simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb Write⇩s⇩b volatile)
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
from read_only_reads_append [of "(𝒪⇩s⇩b ∪ A - R)" "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n)"]
have "read_only_reads
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) (𝒪⇩s⇩b ∪ A - R))
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) ⊆ read_only_reads (𝒪⇩s⇩b ∪ A - R) sb⇩n"
by auto
with ts⇩s⇩b_i nth mth neq_m_i n_bound' True
read_only_reads_unowned [OF i_bound m_bound' False [symmetric] ts⇩s⇩b_i mth']
show ?thesis
by (auto simp add: ts⇩s⇩b' sb 𝒪⇩s⇩b' Write⇩s⇩b volatile)
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩1 ∪ all_acquired sb⇩1) ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}"
proof (cases "i⇩1=i")
case True
with i⇩1_j have i_j: "i≠j"
by simp
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence j_bound'': "j < length (map owned ts⇩s⇩b)"
by simp
from ts_j i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from ownership_distinct [OF i_bound j_bound' i_j ts⇩s⇩b_i ts_j']
show ?thesis
using ts⇩s⇩b_i True ts_i⇩1 i_bound 𝒪⇩s⇩b'
by (auto simp add: ts⇩s⇩b' sb Write⇩s⇩b volatile)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by simp
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b')
show ?thesis
proof (cases "j=i")
case True
from ownership_distinct [OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
show ?thesis
using ts⇩s⇩b_i True ts_j i_bound 𝒪⇩s⇩b'
by (auto simp add: ts⇩s⇩b' sb Write⇩s⇩b volatile)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from ownership_distinct [OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show ?thesis .
qed
qed
qed
qed
have valid_sharing': "valid_sharing (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
i_bound jth ts⇩s⇩b_i show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Write⇩s⇩b volatile)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
have unshared: "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
have "∀a∈dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
proof -
{
fix a
assume a_in: "a ∈ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b"
hence a_R: "a ∈ R"
by clarsimp
assume a_in_j: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
have False
proof -
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
a_in_j
have "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
moreover
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] a_R R_owned
show False
by blast
qed
}
thus ?thesis by blast
qed
from non_volatile_writes_unshared_no_outstanding_non_volatile_Write⇩s⇩b
[OF unshared this]
show ?thesis .
qed
qed
next
show "sharing_consis (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "sharing_consistent (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j"
proof (cases "i=j")
case True
with i_bound jth ts⇩s⇩b_i sharing_consis [OF i_bound ts⇩s⇩b_i]
show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Write⇩s⇩b volatile 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from sharing_consis [OF j_bound' jth']
have consis: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have acq_cond: "all_acquired sb⇩j ∩ dom 𝒮⇩s⇩b - dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof -
{
fix a
assume a_acq: "a ∈ all_acquired sb⇩j"
assume "a ∈ dom 𝒮⇩s⇩b"
assume a_L: "a ∈ L"
have False
proof -
from ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: sb Write⇩s⇩b volatile)
with a_acq a_L L_subset
show False
by blast
qed
}
thus ?thesis
by auto
qed
have uns_cond: "all_unshared sb⇩j ∩ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b = {}"
proof -
{
fix a
assume a_uns: "a ∈ all_unshared sb⇩j"
assume "a ∉ L"
assume a_R: "a ∈ R"
have False
proof -
from unshared_acquired_or_owned [OF consis] a_uns
have "a ∈ all_acquired sb⇩j ∪ 𝒪⇩j" by auto
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] R_owned a_R
show False
by blast
qed
}
thus ?thesis
by auto
qed
from sharing_consistent_preservation [OF consis acq_cond uns_cond]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
qed
next
show "read_only_unowned (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof (cases "i=j")
case True
from read_only_unowned [OF i_bound ts⇩s⇩b_i] R_owned A_R
have "(𝒪⇩s⇩b ∪ A - R) ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs )
with jth ts⇩s⇩b_i i_bound True
show ?thesis
by (auto simp add: 𝒪⇩s⇩b' ts⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from read_only_unowned [OF j_bound' jth']
have "𝒪⇩j ∩ read_only 𝒮⇩s⇩b = {}".
moreover
from ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] R_owned
have "(𝒪⇩s⇩b ∪ A) ∩ 𝒪⇩j = {}"
by (auto simp add: sb Write⇩s⇩b volatile)
moreover note R_owned A_R
ultimately show ?thesis
by (fastforce simp add: in_read_only_convs split: if_split_asm)
qed
qed
next
show "unowned_shared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
show "- ⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') ⊆ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof -
have s: "⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') =
⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b) ∪ A - R"
apply (unfold ts⇩s⇩b' 𝒪⇩s⇩b')
apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound ts⇩s⇩b_i])
apply (rule local.ownership_distinct_axioms)
done
note unowned_shared L_subset A_R
then
show ?thesis
apply (simp only: s)
apply auto
done
qed
qed
next
show "no_outstanding_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "no_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with jth ts⇩s⇩b_i i_bound no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
show ?thesis
by (auto simp add: sb ts⇩s⇩b' Write⇩s⇩b volatile)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
have nw: "no_write_to_read_only_memory 𝒮⇩s⇩b sb⇩j".
have "R ∩ outstanding_refs is_Write⇩s⇩b sb⇩j = {}"
proof -
note dist = ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
dist
have "outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
moreover
from outstanding_volatile_writes_unowned_by_others [OF j_bound' i_bound
False [symmetric] jth' ts⇩s⇩b_i ]
have "outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
ultimately have "outstanding_refs is_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by (auto simp add: misc_outstanding_refs_convs)
with R_owned
show ?thesis by blast
qed
then
have "∀a∈outstanding_refs is_Write⇩s⇩b sb⇩j.
a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: in_read_only_convs)
from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
show ?thesis .
qed
qed
qed
from direct_memop_step.WriteVolatile [OF]
have "(Write True a (D, f) A L R W# is',
?θ, (), m,𝒟, acquired True ?take_sb 𝒪⇩s⇩b, release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b,𝒮) →
(is', ?θ, (), m (a := v),True, acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R, Map.empty,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (simp add: f_v' [symmetric])
from direct_computation.Memop [OF i_bound' ts_i this]
have store_step:
"(ts, m, 𝒮) ⇒⇩d (?ts', m(a := v),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)".
have sb'_split:
"sb' = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb' @
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'"
by simp
from reads_consis
have no_vol_reads: "outstanding_refs is_volatile_Read⇩s⇩b sb' = {}"
by (simp add: sb Write⇩s⇩b True)
hence "outstanding_refs is_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
= {}"
by (auto simp add: outstanding_refs_conv dest: set_takeWhileD)
moreover
have "outstanding_refs is_volatile_Write⇩s⇩b
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = {}"
proof -
have "∀r ∈ set (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'). ¬ (is_volatile_Write⇩s⇩b r)"
by (auto dest: set_takeWhileD)
thus ?thesis
by (simp add: outstanding_refs_conv)
qed
ultimately
have no_volatile:
"outstanding_refs is_volatile (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') = {}"
by (auto simp add: outstanding_refs_conv is_volatile_split)
moreover
from no_vol_reads have "∀r ∈ set sb'. ¬ is_volatile_Read⇩s⇩b r"
by (fastforce simp add: outstanding_refs_conv is_volatile_Read⇩s⇩b_def
split: memref.splits)
hence "∀r ∈ set sb'. (Not ∘ is_volatile_Write⇩s⇩b) r = (Not ∘ is_volatile) r"
by (auto simp add: is_volatile_split)
hence takeWhile_eq: "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') =
(takeWhile (Not ∘ is_volatile) sb')"
apply -
apply (rule takeWhile_cong)
apply auto
done
from leq
have leq': "length ts⇩s⇩b = length ?ts'"
by simp
hence i_bound_ts': "i < length ?ts'" using i_bound by simp
from is'_sim
have is'_sim_split:
"instrs
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb' @
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is' @ prog_instrs (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb' @
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
by (simp add: sb'_split [symmetric])
from reads_consistent_flush_all_until_volatile_write [OF ‹valid_ownership_and_sharing 𝒮⇩s⇩b ts⇩s⇩b›
i_bound ts⇩s⇩b_i reads_consis]
have "reads_consistent True (acquired True ?take_sb 𝒪⇩s⇩b) m (Write⇩s⇩b True a (D,f) v A L R W#sb')"
by (simp add: m sb Write⇩s⇩b volatile)
hence "reads_consistent True (acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R) (m(a:=v)) sb'"
by simp
from reads_consistent_takeWhile [OF this]
have r_consis': "reads_consistent True (acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R) (m(a:=v))
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')".
from last_prog have last_prog_sb': "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb Write⇩s⇩b )
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have "∀sop ∈ write_sops sb'. valid_sop sop"
by (auto simp add: sb Write⇩s⇩b)
hence valid_sop': "∀sop∈write_sops (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb').
valid_sop sop"
by (fastforce dest: set_takeWhileD simp add: in_write_sops_conv)
from no_volatile
have no_volatile_Read⇩s⇩b:
"outstanding_refs is_volatile_Read⇩s⇩b (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') =
{}"
by (auto simp add: outstanding_refs_conv is_volatile_Read⇩s⇩b_def split: memref.splits)
from flush_store_buffer_append [OF i_bound_ts' is'_sim_split, simplified,
OF causal_program_history_sb' ts'_i refl last_prog_sb' r_consis' hist_consis'
valid_sop' dist_sb' no_volatile_Read⇩s⇩b_volatile_reads_consistent [OF no_volatile_Read⇩s⇩b],
where 𝒮="(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"]
obtain is'' where
is''_sim: "instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is'' @ prog_instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')" and
steps: "(?ts', m(a := v), 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) ⇒⇩d⇧*
(ts[i := (last_prog (hd_prog p⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'))
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'),
is'',
θ⇩s⇩b |` (dom θ⇩s⇩b -
read_tmps (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')),
(), True, acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
(acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R),
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
(dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty)],
flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (m(a := v)),
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
by (auto)
note sim_flush = r_rtranclp_rtranclp [OF store_step steps]
moreover
note flush_commute =
flush_flush_all_until_volatile_write_Write⇩s⇩b_volatile_commute [OF i_bound ts⇩s⇩b_i [simplified sb Write⇩s⇩b True]
outstanding_refs_is_Write⇩s⇩b_takeWhile_disj a_notin_others']
from last_prog_hd_prog_append' [where sb="(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
and sb'="(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')",
simplified sb'_split [symmetric], OF hist_consis' last_prog_sb']
have last_prog_eq:
"last_prog (hd_prog p⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'))
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') =
hd_prog p⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')".
have take_emtpy: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (r#sb) = []"
by (simp add: Write⇩s⇩b True)
have dist_sb': "∀i p is 𝒪 ℛ 𝒟 θ sb.
i < length ts⇩s⇩b ⟶
ts⇩s⇩b ! i = (p, is, θ, sb, 𝒟, 𝒪, ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')) =
{}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_sb': "x ∈ (all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'))"
have False
proof (cases "i=j")
case True with x_shared ts⇩s⇩b_i jth show False by (simp add: sb volatile Write⇩s⇩b)
next
case False
from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
all_unshared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have "x ∈ all_acquired sb⇩j ∪ 𝒪⇩j "
by auto
moreover
from x_sb' all_shared_acquired_or_owned [OF sharing_consis [OF i_bound ts⇩s⇩b_i]]
unshared_acquired_or_owned [OF sharing_consis [OF i_bound ts⇩s⇩b_i]]
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"]
all_unshared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"]
all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"]
have "x ∈ all_acquired sb ∪ 𝒪⇩s⇩b"
by (auto simp add: sb Write⇩s⇩b volatile)
moreover
note ownership_distinct [OF i_bound j_bound False ts⇩s⇩b_i jth]
ultimately show False by blast
qed
}
thus ?thesis by blast
qed
have dist_R_L_A: "∀j p is 𝒪 ℛ 𝒟 θ sb.
j < length ts⇩s⇩b ⟶ i≠ j⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪, ℛ) ⟶
(all_shared sb ∪ all_unshared sb ∪ all_acquired sb) ∩ (R ∪ L ∪ A) = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared sb⇩j ∪
all_unshared sb⇩j ∪
all_acquired sb⇩j"
assume x_R_L_A: "x ∈ R ∪ L ∪ A"
have False
proof -
from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
have "x ∈ all_acquired sb⇩j ∪ 𝒪⇩j "
by auto
moreover
from x_R_L_A R_owned L_subset
have "x ∈ all_acquired sb ∪ 𝒪⇩s⇩b"
by (auto simp add: sb Write⇩s⇩b volatile)
moreover
note ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
ultimately show False by blast
qed
}
thus ?thesis by blast
qed
from local.ownership_distinct_axioms have "ownership_distinct ts⇩s⇩b" .
from local.sharing_consis_axioms have "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b".
note share_commute=
share_all_until_volatile_write_flush_commute [OF take_empty ‹ownership_distinct ts⇩s⇩b› ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b› i_bound ts⇩s⇩b_i dist_sb' dist_R_L_A]
have rel_commute_empty:
"release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (dom 𝒮 ∪ R - L) Map.empty =
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (dom 𝒮⇩s⇩b ∪ R - L) Map.empty"
proof -
{
fix a
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
have "(a ∈ (dom 𝒮 ∪ R - L)) = (a ∈ (dom 𝒮⇩s⇩b ∪ R - L))"
proof -
from all_shared_acquired_or_owned [OF sharing_consis [OF i_bound ts⇩s⇩b_i]] a_in
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"]
have "a ∈ 𝒪⇩s⇩b ∪ all_acquired sb "
by (auto simp add: sb Write⇩s⇩b volatile)
from share_all_until_volatile_write_thread_local [OF ‹ownership_distinct ts⇩s⇩b› ‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b› i_bound ts⇩s⇩b_i this]
have "𝒮 a = 𝒮⇩s⇩b a"
by (auto simp add: sb Write⇩s⇩b volatile 𝒮)
then show ?thesis
by (auto simp add: domIff)
qed
}
then show ?thesis
apply -
apply (rule release_all_shared_exchange)
apply auto
done
qed
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume j_bound: "j < length ts⇩s⇩b"
assume neq: "i ≠ j"
have "release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b ∪ R - L) ℛ⇩j
= release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b) ℛ⇩j"
proof -
{
fix a
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
have "(a ∈ (dom 𝒮⇩s⇩b ∪ R - L)) = (a ∈ dom 𝒮⇩s⇩b)"
proof -
from ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i jth]
have A_dist: "A ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by (auto simp add: sb Write⇩s⇩b volatile)
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have a_in: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i jth]
have "a ∉ (𝒪⇩s⇩b ∪ all_acquired sb)" by auto
with A_dist R_owned A_R A_shared_owned L_subset a_in
obtain "a ∉ R" and "a ∉ L"
by fastforce
then show ?thesis by auto
qed
}
then
show ?thesis
apply -
apply (rule release_all_shared_exchange)
apply auto
done
qed
}
note release_commute = this
have "(ts⇩s⇩b [i := (p⇩s⇩b,is⇩s⇩b, θ⇩s⇩b, sb', 𝒟⇩s⇩b, 𝒪⇩s⇩b ∪ A - R,Map.empty)],m⇩s⇩b(a:=v),𝒮⇩s⇩b') ∼
(ts[i := (last_prog (hd_prog p⇩s⇩b (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'))
(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb'),
is'',
θ⇩s⇩b |` (dom θ⇩s⇩b -
read_tmps (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')),
(),True, acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
(acquired True ?take_sb 𝒪⇩s⇩b ∪ A - R),
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
(dom (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)) Map.empty)],
flush (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (m(a := v)),
share (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') (𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L))"
apply (rule sim_config.intros)
apply (simp add: flush_commute m)
apply (clarsimp simp add: 𝒮⇩s⇩b' 𝒮 share_commute simp del: restrict_restrict)
using leq
apply simp
using i_bound i_bound' ts_sim 𝒟
apply (clarsimp simp add: Let_def nth_list_update is''_sim last_prog_eq sb Write⇩s⇩b volatile 𝒮⇩s⇩b'
rel_commute_empty
split: if_split_asm )
apply (rule conjI)
apply blast
apply clarsimp
apply (frule (2) release_commute)
apply clarsimp
apply fastforce
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid'
m⇩s⇩b' 𝒮⇩s⇩b' ts⇩s⇩b'
by (auto simp del: fun_upd_apply simp add: 𝒪⇩s⇩b' ℛ⇩s⇩b' )
next
case False
note non_vol = this
from flush Write⇩s⇩b False
obtain
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b' = ℛ⇩s⇩b"
by cases (auto simp add: sb)
from non_volatile_owned non_vol have a_owned: "a ∈ 𝒪⇩s⇩b"
by simp
{
fix j
fix p⇩j is⇩s⇩b⇩j 𝒪⇩j 𝒟⇩s⇩b⇩j θ⇩j ℛ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b"
assume ts⇩s⇩b_j: "ts⇩s⇩b!j=(p⇩j,is⇩s⇩b⇩j,θ⇩j,sb⇩j,𝒟⇩s⇩b⇩j,𝒪⇩j,ℛ⇩j)"
assume neq_i_j: "i≠j"
have "a ∉ unforwarded_non_volatile_reads (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) {}"
proof
let ?take_sb⇩j = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
let ?drop_sb⇩j = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
assume a_in: "a ∈ unforwarded_non_volatile_reads ?drop_sb⇩j {}"
from a_unowned_by_others [rule_format, OF j_bound neq_i_j] ts⇩s⇩b_j
obtain a_unowned: "a ∉ 𝒪⇩j" and a_unacq: "a ∉ all_acquired sb⇩j"
by auto
with all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j] acquired_takeWhile_non_volatile_Write⇩s⇩b [of sb⇩j 𝒪⇩j]
have a_unacq_take: "a ∉ acquired True ?take_sb⇩j 𝒪⇩j"
by (auto )
note nvo_j = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound ts⇩s⇩b_j]
from non_volatile_owned_or_read_only_drop [OF nvo_j]
have nvo_drop_j: "non_volatile_owned_or_read_only True (share ?take_sb⇩j 𝒮⇩s⇩b)
(acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j" .
from in_unforwarded_non_volatile_reads_non_volatile_Read⇩s⇩b [OF a_in]
have a_in': "a ∈ outstanding_refs is_non_volatile_Read⇩s⇩b ?drop_sb⇩j".
from non_volatile_owned_or_read_only_outstanding_refs [OF nvo_drop_j] a_in'
have "a ∈ acquired True ?take_sb⇩j 𝒪⇩j ∪ all_acquired ?drop_sb⇩j ∪
read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
by (auto simp add: misc_outstanding_refs_convs)
moreover
from acquired_append [of True ?take_sb⇩j ?drop_sb⇩j 𝒪⇩j] acquired_all_acquired [of True ?take_sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have "acquired True ?take_sb⇩j 𝒪⇩j ∪ all_acquired ?drop_sb⇩j ⊆ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
ultimately
have "a ∈ read_only_reads (acquired True ?take_sb⇩j 𝒪⇩j) ?drop_sb⇩j"
using a_owned ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i ts⇩s⇩b_j]
by auto
with read_only_reads_unowned [OF j_bound i_bound neq_i_j [symmetric] ts⇩s⇩b_j ts⇩s⇩b_i] a_owned
show False
by auto
qed
} note a_notin_unforwarded_non_volatile_reads_drop = this
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "reads_consistent False 𝒪⇩j m⇩s⇩b' sb⇩j"
proof (cases "i=j")
case True
from reads_consis ts_j j_bound sb show ?thesis
by (clarsimp simp add: True m⇩s⇩b' Write⇩s⇩b ts⇩s⇩b' 𝒪⇩s⇩b' False reads_consistent_pending_write_antimono)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
moreover from ts_j False have ts_j': "ts⇩s⇩b ! j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
using j_bound by (simp add: ts⇩s⇩b')
ultimately have consis_m: "reads_consistent False 𝒪⇩j m⇩s⇩b sb⇩j"
by (rule valid_reads)
from a_unowned_by_others [rule_format, OF j_bound' False] ts_j'
have a_unowned:"a ∉ 𝒪⇩j ∪ all_acquired sb⇩j"
by simp
let ?take_sb⇩j = "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
let ?drop_sb⇩j = "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j"
from a_unowned acquired_reads_all_acquired [of True ?take_sb⇩j 𝒪⇩j]
all_acquired_append [of ?take_sb⇩j ?drop_sb⇩j]
have a_not_acq_reads: "a ∉ acquired_reads True ?take_sb⇩j 𝒪⇩j"
by auto
moreover
note a_unfw= a_notin_unforwarded_non_volatile_reads_drop [OF j_bound' ts_j' False]
ultimately
show ?thesis
using reads_consistent_mem_eq_on_unforwarded_non_volatile_reads_drop [where W="{}" and
A="unforwarded_non_volatile_reads ?drop_sb⇩j {} ∪ acquired_reads True ?take_sb⇩j 𝒪⇩j" and
m'= "(m⇩s⇩b(a:=v))", OF _ _ _ consis_m]
by (fastforce simp add: m⇩s⇩b')
qed
qed
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i] sb
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: Write⇩s⇩b False)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' Write⇩s⇩b False 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
from sb
have out: "outstanding_refs is_volatile_Write⇩s⇩b sb' ⊆ outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: Write⇩s⇩b False)
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Write⇩s⇩b False sb)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i out acq]
show ?thesis by (simp add: ts⇩s⇩b' Write⇩s⇩b False 𝒪⇩s⇩b')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof -
have ro: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: sb Write⇩s⇩b non_vol)
have "𝒪⇩s⇩b ∪ all_acquired sb' ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (auto simp add: sb Write⇩s⇩b non_vol)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i ro this]
show ?thesis
by (simp add: ts⇩s⇩b' sb 𝒪⇩s⇩b')
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Write⇩s⇩b False sb)
with ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show ?thesis by (simp add: ts⇩s⇩b' Write⇩s⇩b False 𝒪⇩s⇩b')
qed
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb'"
by (auto simp add: sb Write⇩s⇩b False)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: sb Write⇩s⇩b False)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b sb'"
by (auto simp add: sb Write⇩s⇩b False)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb)
qed
from is_sim
obtain is_sim: "instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is @ prog_instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
by (simp add: suspends sb Write⇩s⇩b False)
have "(ts,m,𝒮) ⇒⇩d⇧* (ts,m,𝒮)" by blast
moreover
note flush_commute =
flush_all_until_volatile_write_Write⇩s⇩b_non_volatile_commute [OF i_bound ts⇩s⇩b_i [simplified sb Write⇩s⇩b non_vol]
outstanding_refs_is_Write⇩s⇩b_takeWhile_disj a_notin_others']
note share_commute =
share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound ts⇩s⇩b_i, simplified sb Write⇩s⇩b False, simplified]
have "(ts⇩s⇩b [i := (p⇩s⇩b,is⇩s⇩b,θ⇩s⇩b, sb', 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)], m⇩s⇩b(a:=v),𝒮⇩s⇩b') ∼
(ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' is_sim ts_i ts_sim 𝒟
apply (clarsimp simp add: Let_def nth_list_update suspends sb Write⇩s⇩b False 𝒮⇩s⇩b'
split: if_split_asm )
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' m⇩s⇩b'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_program_history' valid'
ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b' ℛ⇩s⇩b'
by (auto simp del: fun_upd_apply)
qed
next
case (Read⇩s⇩b volatile a t v)
from flush this obtain m⇩s⇩b': "m⇩s⇩b'=m⇩s⇩b" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and 𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b"
by cases (auto simp add: sb)
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i] sb
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: Read⇩s⇩b)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' Read⇩s⇩b 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
from sb
have out: "outstanding_refs is_volatile_Write⇩s⇩b sb' ⊆ outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: Read⇩s⇩b)
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Read⇩s⇩b sb)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i out acq]
show ?thesis by (simp add: ts⇩s⇩b' Read⇩s⇩b 𝒪⇩s⇩b')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof -
have ro: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: sb Read⇩s⇩b)
have "𝒪⇩s⇩b ∪ all_acquired sb' ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (auto simp add: sb Read⇩s⇩b)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i ro this]
show ?thesis
by (simp add: ts⇩s⇩b' sb 𝒪⇩s⇩b')
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Read⇩s⇩b sb)
with ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show ?thesis by (simp add: ts⇩s⇩b' Read⇩s⇩b 𝒪⇩s⇩b')
qed
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb'"
by (auto simp add: sb Read⇩s⇩b)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: sb Read⇩s⇩b)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b sb'"
by (auto simp add: sb Read⇩s⇩b)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb)
qed
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb'"
by (simp add: sb Read⇩s⇩b)
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: m⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b sb'"
by (simp add: sb Read⇩s⇩b causal_program_history_def)
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb Read⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
from is_sim
have is_sim: "instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is @ prog_instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
by (simp add: sb Read⇩s⇩b suspends)
from valid_history [OF i_bound ts⇩s⇩b_i]
have θ⇩s⇩b_v: "θ⇩s⇩b t = Some v"
by (simp add: history_consistent_access_last_read sb Read⇩s⇩b split:option.splits)
have "(ts,m,𝒮) ⇒⇩d⇧* (ts,m,𝒮)" by blast
moreover
note flush_commute= flush_all_until_volatile_write_Read⇩s⇩b_commute [OF i_bound ts⇩s⇩b_i [simplified sb Read⇩s⇩b]]
note share_commute =
share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound ts⇩s⇩b_i, simplified sb Read⇩s⇩b, simplified]
have "(ts⇩s⇩b [i := (p⇩s⇩b,is⇩s⇩b, θ⇩s⇩b, sb',𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b')],m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' ts_sim ts_i is_sim 𝒟
apply (clarsimp simp add: Let_def nth_list_update sb suspends Read⇩s⇩b 𝒮⇩s⇩b' ℛ⇩s⇩b'
split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' m⇩s⇩b'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing'
valid_program_history' valid'
ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
from flush this obtain m⇩s⇩b': "m⇩s⇩b'=m⇩s⇩b" and
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b" and 𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'=ℛ⇩s⇩b"
by cases (auto simp add: sb)
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i] sb
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: Prog⇩s⇩b)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' Prog⇩s⇩b 𝒪⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
from sb
have out: "outstanding_refs is_volatile_Write⇩s⇩b sb' ⊆ outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: Prog⇩s⇩b)
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Prog⇩s⇩b sb)
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i out acq]
show ?thesis by (simp add: ts⇩s⇩b' Prog⇩s⇩b 𝒪⇩s⇩b')
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof -
have ro: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
by (auto simp add: sb Prog⇩s⇩b)
have "𝒪⇩s⇩b ∪ all_acquired sb' ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (auto simp add: sb Prog⇩s⇩b)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i ro this]
show ?thesis
by (simp add: ts⇩s⇩b' sb 𝒪⇩s⇩b')
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
have acq: "all_acquired sb' ⊆ all_acquired sb"
by (auto simp add: Prog⇩s⇩b sb)
with ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i]
show ?thesis by (simp add: ts⇩s⇩b' Prog⇩s⇩b 𝒪⇩s⇩b')
qed
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b sb'"
by (auto simp add: sb Prog⇩s⇩b)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b sb'"
by (auto simp add: sb Prog⇩s⇩b)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒪⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b sb'"
by (auto simp add: sb Prog⇩s⇩b)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b' sb)
qed
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb'"
by (simp add: sb Prog⇩s⇩b)
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: m⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b sb'"
by (simp add: sb Prog⇩s⇩b causal_program_history_def)
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩2 sb' = p⇩s⇩b"
by (simp add: sb Prog⇩s⇩b)
from last_prog_to_last_prog_same [OF this]
have "last_prog p⇩s⇩b sb' = p⇩s⇩b".
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
from is_sim
have is_sim: "instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is @ prog_instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
by (simp add: suspends sb Prog⇩s⇩b)
have "(ts,m,𝒮) ⇒⇩d⇧* (ts,m,𝒮)" by blast
moreover
note flush_commute = flush_all_until_volatile_write_Prog⇩s⇩b_commute [OF i_bound
ts⇩s⇩b_i [simplified sb Prog⇩s⇩b]]
note share_commute =
share_all_until_volatile_write_update_sb [of sb' sb, OF _ i_bound ts⇩s⇩b_i, simplified sb Prog⇩s⇩b, simplified]
have "(ts⇩s⇩b [i := (p⇩s⇩b,is⇩s⇩b, θ⇩s⇩b, sb',𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)],m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' ts_sim ts_i is_sim 𝒟
apply (clarsimp simp add: Let_def nth_list_update sb suspends Prog⇩s⇩b ℛ⇩s⇩b' 𝒮⇩s⇩b'
split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' m⇩s⇩b'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing'
valid_program_history' valid'
ts⇩s⇩b' 𝒮⇩s⇩b' 𝒪⇩s⇩b' ℛ⇩s⇩b' 𝒮⇩s⇩b'
by (auto simp del: fun_upd_apply)
next
case (Ghost⇩s⇩b A L R W)
from flush Ghost⇩s⇩b
obtain
𝒪⇩s⇩b': "𝒪⇩s⇩b'=𝒪⇩s⇩b ∪ A - R" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L" and
ℛ⇩s⇩b': "ℛ⇩s⇩b'= augment_rels (dom 𝒮⇩s⇩b) R ℛ⇩s⇩b" and
m⇩s⇩b': "m⇩s⇩b'=m⇩s⇩b"
by cases (auto simp add: sb)
from sharing_consis [OF i_bound ts⇩s⇩b_i]
obtain
A_shared_owned: "A ⊆ dom 𝒮⇩s⇩b ∪ 𝒪⇩s⇩b" and
L_subset: "L ⊆ A" and
A_R: "A ∩ R = {}" and
R_owned: "R ⊆ 𝒪⇩s⇩b"
by (clarsimp simp add: sb Ghost⇩s⇩b)
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof
fix j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j acq⇩j θ⇩j sb⇩j p⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume ts⇩s⇩b'_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_owned_or_read_only False 𝒮⇩s⇩b' 𝒪⇩j sb⇩j"
proof (cases "j=i")
case True
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) (𝒪⇩s⇩b ∪ A - R) sb'"
by (auto simp add: sb Ghost⇩s⇩b non_volatile_owned_or_read_only_pending_write_antimono)
then show ?thesis
using True i_bound ts⇩s⇩b'_j
by (auto simp add: ts⇩s⇩b' 𝒮⇩s⇩b' sb 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with ts⇩s⇩b'_j False i_bound
have ts⇩s⇩b_j: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
note nvo = outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' ts⇩s⇩b_j]
from read_only_unowned [OF i_bound ts⇩s⇩b_i] R_owned
have "R ∩ read_only 𝒮⇩s⇩b = {}"
by auto
with read_only_reads_unowned [OF j_bound' i_bound False ts⇩s⇩b_j ts⇩s⇩b_i] L_subset
have "∀a∈read_only_reads
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) 𝒪⇩j)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j).
a ∈ read_only 𝒮⇩s⇩b ⟶ a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L )"
by (auto simp add: in_read_only_convs sb Ghost⇩s⇩b)
from non_volatile_owned_or_read_only_read_only_reads_eq' [OF nvo this]
have "non_volatile_owned_or_read_only False (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j".
thus ?thesis by (simp add: 𝒮⇩s⇩b')
qed
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}"
proof (cases "i⇩1=i")
case True
from i⇩1_j True have neq_i_j: "i≠j"
by auto
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j neq_i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others [OF i_bound j_bound' neq_i_j
ts⇩s⇩b_i ts_j'] ts_i⇩1 i_bound ts⇩s⇩b_i True show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Ghost⇩s⇩b)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b' sb)
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by auto
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b' sb)
show ?thesis
proof (cases "j=i")
case True
from outstanding_volatile_writes_unowned_by_others [OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i ]
have "(𝒪⇩s⇩b ∪ all_acquired sb) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}".
then show ?thesis
using True i⇩1_i ts_j ts⇩s⇩b_i i_bound
by (auto simp add: sb Ghost⇩s⇩b ts⇩s⇩b' 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from outstanding_volatile_writes_unowned_by_others
[OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show "(𝒪⇩j ∪ all_acquired sb⇩j) ∩ outstanding_refs is_volatile_Write⇩s⇩b sb⇩1 = {}" .
qed
qed
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof
fix n m
fix p⇩n "is⇩n" 𝒪⇩n ℛ⇩n 𝒟⇩n θ⇩n sb⇩n p⇩m "is⇩m" 𝒪⇩m ℛ⇩m 𝒟⇩m θ⇩m sb⇩m
assume n_bound: "n < length ts⇩s⇩b'"
and m_bound: "m < length ts⇩s⇩b'"
and neq_n_m: "n≠m"
and nth: "ts⇩s⇩b'!n = (p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
and mth: "ts⇩s⇩b'!m =(p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
from n_bound have n_bound': "n < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
from m_bound have m_bound': "m < length ts⇩s⇩b" by (simp add: ts⇩s⇩b')
show "(𝒪⇩m ∪ all_acquired sb⇩m) ∩
read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) 𝒪⇩n)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) =
{}"
proof (cases "m=i")
case True
with neq_n_m have neq_n_i: "n≠i"
by auto
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
note read_only_reads_unowned [OF n_bound' i_bound neq_n_i nth' ts⇩s⇩b_i]
then
show ?thesis
using True ts⇩s⇩b_i neq_n_i nth mth n_bound' m_bound' L_subset
by (auto simp add: ts⇩s⇩b' 𝒪⇩s⇩b' sb Ghost⇩s⇩b)
next
case False
note neq_m_i = this
with m_bound mth i_bound have mth': "ts⇩s⇩b!m = (p⇩m, is⇩m, θ⇩m, sb⇩m, 𝒟⇩m, 𝒪⇩m,ℛ⇩m)"
by (auto simp add: ts⇩s⇩b')
show ?thesis
proof (cases "n=i")
case True
from read_only_reads_append [of "(𝒪⇩s⇩b ∪ A - R)" "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n)"]
have "read_only_reads
(acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) (𝒪⇩s⇩b ∪ A - R))
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩n) ⊆ read_only_reads (𝒪⇩s⇩b ∪ A - R) sb⇩n"
by auto
with ts⇩s⇩b_i nth mth neq_m_i n_bound' True
read_only_reads_unowned [OF i_bound m_bound' False [symmetric] ts⇩s⇩b_i mth']
show ?thesis
by (auto simp add: ts⇩s⇩b' sb 𝒪⇩s⇩b' Ghost⇩s⇩b)
next
case False
with n_bound nth i_bound have nth': "ts⇩s⇩b!n =(p⇩n, is⇩n, θ⇩n, sb⇩n, 𝒟⇩n, 𝒪⇩n,ℛ⇩n)"
by (auto simp add: ts⇩s⇩b')
from read_only_reads_unowned [OF n_bound' m_bound' neq_n_m nth' mth'] False neq_m_i
show ?thesis
by (clarsimp)
qed
qed
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof (unfold_locales)
fix i⇩1 j p⇩1 "is⇩1" 𝒪⇩1 ℛ⇩1 𝒟⇩1 xs⇩1 sb⇩1 p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume i⇩1_bound: "i⇩1 < length ts⇩s⇩b'"
assume j_bound: "j < length ts⇩s⇩b'"
assume i⇩1_j: "i⇩1 ≠ j"
assume ts_i⇩1: "ts⇩s⇩b'!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
assume ts_j: "ts⇩s⇩b'!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "(𝒪⇩1 ∪ all_acquired sb⇩1) ∩ (𝒪⇩j ∪ all_acquired sb⇩j)= {}"
proof (cases "i⇩1=i")
case True
with i⇩1_j have i_j: "i≠j"
by simp
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence j_bound'': "j < length (map owned ts⇩s⇩b)"
by simp
from ts_j i_j have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from ownership_distinct [OF i_bound j_bound' i_j ts⇩s⇩b_i ts_j']
show ?thesis
using ts⇩s⇩b_i True ts_i⇩1 i_bound 𝒪⇩s⇩b'
by (auto simp add: ts⇩s⇩b' sb Ghost⇩s⇩b)
next
case False
note i⇩1_i = this
from i⇩1_bound have i⇩1_bound': "i⇩1 < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
hence i⇩1_bound'': "i⇩1 < length (map owned ts⇩s⇩b)"
by simp
from ts_i⇩1 False have ts_i⇩1': "ts⇩s⇩b!i⇩1 = (p⇩1,is⇩1,xs⇩1,sb⇩1,𝒟⇩1,𝒪⇩1,ℛ⇩1)"
by (simp add: ts⇩s⇩b')
show ?thesis
proof (cases "j=i")
case True
from ownership_distinct [OF i⇩1_bound' i_bound i⇩1_i ts_i⇩1' ts⇩s⇩b_i]
show ?thesis
using ts⇩s⇩b_i True ts_j i_bound 𝒪⇩s⇩b'
by (auto simp add: ts⇩s⇩b' sb Ghost⇩s⇩b)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (simp add: ts⇩s⇩b')
from ts_j False have ts_j': "ts⇩s⇩b!j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (simp add: ts⇩s⇩b')
from ownership_distinct [OF i⇩1_bound' j_bound' i⇩1_j ts_i⇩1' ts_j']
show ?thesis .
qed
qed
qed
qed
have valid_sharing': "valid_sharing (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "non_volatile_writes_unshared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
i_bound jth ts⇩s⇩b_i show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Ghost⇩s⇩b)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from j_bound jth i_bound False
have j: "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j"
apply -
apply (rule outstanding_non_volatile_writes_unshared)
apply (auto simp add: ts⇩s⇩b')
done
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from outstanding_non_volatile_writes_unshared [OF j_bound' jth']
have unshared: "non_volatile_writes_unshared 𝒮⇩s⇩b sb⇩j".
have "∀a∈dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b. a ∉ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
proof -
{
fix a
assume a_in: "a ∈ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b"
hence a_R: "a ∈ R"
by clarsimp
assume a_in_j: "a ∈ outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j"
have False
proof -
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes [OF
outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
a_in_j
have "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
moreover
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] a_R R_owned
show False
by blast
qed
}
thus ?thesis by blast
qed
from non_volatile_writes_unshared_no_outstanding_non_volatile_Write⇩s⇩b
[OF unshared this]
show ?thesis .
qed
qed
next
show "sharing_consis (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j acq⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "sharing_consistent (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) 𝒪⇩j sb⇩j"
proof (cases "i=j")
case True
with i_bound jth ts⇩s⇩b_i sharing_consis [OF i_bound ts⇩s⇩b_i]
show ?thesis
by (clarsimp simp add: ts⇩s⇩b' sb Ghost⇩s⇩b 𝒪⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
from jth False have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from sharing_consis [OF j_bound' jth']
have consis: "sharing_consistent 𝒮⇩s⇩b 𝒪⇩j sb⇩j".
have acq_cond: "all_acquired sb⇩j ∩ dom 𝒮⇩s⇩b - dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof -
{
fix a
assume a_acq: "a ∈ all_acquired sb⇩j"
assume "a ∈ dom 𝒮⇩s⇩b"
assume a_L: "a ∈ L"
have False
proof -
from ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
have "A ∩ all_acquired sb⇩j = {}"
by (auto simp add: sb Ghost⇩s⇩b)
with a_acq a_L L_subset
show False
by blast
qed
}
thus ?thesis
by auto
qed
have uns_cond: "all_unshared sb⇩j ∩ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) - dom 𝒮⇩s⇩b = {}"
proof -
{
fix a
assume a_uns: "a ∈ all_unshared sb⇩j"
assume "a ∉ L"
assume a_R: "a ∈ R"
have False
proof -
from unshared_acquired_or_owned [OF consis] a_uns
have "a ∈ all_acquired sb⇩j ∪ 𝒪⇩j" by auto
with ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] R_owned a_R
show False
by blast
qed
}
thus ?thesis
by auto
qed
from sharing_consistent_preservation [OF consis acq_cond uns_cond]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
qed
next
show "unowned_shared (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof (unfold_locales)
show "- ⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') ⊆ dom (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L)"
proof -
have s: "⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b') =
⋃((λ(_,_, _, _,_, 𝒪,_). 𝒪) ` set ts⇩s⇩b) ∪ A - R"
apply (unfold ts⇩s⇩b' 𝒪⇩s⇩b')
apply (rule acquire_release_ownership_nth_update [OF R_owned i_bound ts⇩s⇩b_i])
apply (rule local.ownership_distinct_axioms)
done
note unowned_shared L_subset A_R
then
show ?thesis
apply (simp only: s)
apply auto
done
qed
qed
next
show "read_only_unowned (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "𝒪⇩j ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
proof (cases "i=j")
case True
from read_only_unowned [OF i_bound ts⇩s⇩b_i]
have "(𝒪⇩s⇩b ∪ A - R ) ∩ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) = {}"
by (auto simp add: in_read_only_convs )
with jth ts⇩s⇩b_i i_bound True
show ?thesis
by (auto simp add: 𝒪⇩s⇩b' ts⇩s⇩b')
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from read_only_unowned [OF j_bound' jth']
have "𝒪⇩j ∩ read_only 𝒮⇩s⇩b = {}".
moreover
from ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth'] R_owned
have "(𝒪⇩s⇩b ∪ A) ∩ 𝒪⇩j = {}"
by (auto simp add: sb Ghost⇩s⇩b)
moreover note R_owned A_R
ultimately show ?thesis
by (fastforce simp add: in_read_only_convs split: if_split_asm)
qed
qed
next
show "no_outstanding_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ts⇩s⇩b'"
proof
fix j p⇩j "is⇩j" "𝒪⇩j" ℛ⇩j 𝒟⇩j xs⇩j sb⇩j
assume j_bound: "j < length ts⇩s⇩b'"
assume jth: "ts⇩s⇩b' ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
show "no_write_to_read_only_memory (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) sb⇩j"
proof (cases "i=j")
case True
with jth ts⇩s⇩b_i i_bound no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
show ?thesis
by (auto simp add: sb ts⇩s⇩b' Ghost⇩s⇩b)
next
case False
from j_bound have j_bound': "j < length ts⇩s⇩b"
by (auto simp add: ts⇩s⇩b')
with False jth have jth': "ts⇩s⇩b ! j = (p⇩j,is⇩j,xs⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
by (auto simp add: ts⇩s⇩b')
from no_outstanding_write_to_read_only_memory [OF j_bound' jth']
have nw: "no_write_to_read_only_memory 𝒮⇩s⇩b sb⇩j".
have "R ∩ outstanding_refs is_Write⇩s⇩b sb⇩j = {}"
proof -
note dist = ownership_distinct [OF i_bound j_bound' False ts⇩s⇩b_i jth']
from non_volatile_owned_or_read_only_outstanding_non_volatile_writes
[OF outstanding_non_volatile_refs_owned_or_read_only [OF j_bound' jth']]
dist
have "outstanding_refs is_non_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
moreover
from outstanding_volatile_writes_unowned_by_others [OF j_bound' i_bound
False [symmetric] jth' ts⇩s⇩b_i ]
have "outstanding_refs is_volatile_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by auto
ultimately have "outstanding_refs is_Write⇩s⇩b sb⇩j ∩ 𝒪⇩s⇩b = {}"
by (auto simp add: misc_outstanding_refs_convs)
with R_owned
show ?thesis by blast
qed
then
have "∀a∈outstanding_refs is_Write⇩s⇩b sb⇩j.
a ∈ read_only (𝒮⇩s⇩b ⊕⇘W⇙ R ⊖⇘A⇙ L) ⟶ a ∈ read_only 𝒮⇩s⇩b"
by (auto simp add: in_read_only_convs)
from no_write_to_read_only_memory_read_only_reads_eq [OF nw this]
show ?thesis .
qed
qed
qed
have valid_reads': "valid_reads m⇩s⇩b' ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False (𝒪⇩s⇩b ∪ A - R) m⇩s⇩b sb'"
by (simp add: sb Ghost⇩s⇩b)
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: m⇩s⇩b' ts⇩s⇩b' 𝒪⇩s⇩b')
qed
have valid_program_history': "valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
then have causal': "causal_program_history is⇩s⇩b sb'"
by (simp add: sb Ghost⇩s⇩b causal_program_history_def)
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have "last_prog p⇩s⇩b sb = p⇩s⇩b".
hence "last_prog p⇩s⇩b sb' = p⇩s⇩b"
by (simp add: sb Ghost⇩s⇩b)
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
from is_sim
have is_sim: "instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb') @ is⇩s⇩b =
is @ prog_instrs (dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb')"
by (simp add: sb Ghost⇩s⇩b suspends)
have "(ts,m,𝒮) ⇒⇩d⇧* (ts,m,𝒮)" by blast
moreover
note flush_commute =
flush_all_until_volatile_write_Ghost⇩s⇩b_commute [OF i_bound ts⇩s⇩b_i [simplified sb Ghost⇩s⇩b]]
have dist_R_L_A: "∀j p is 𝒪 ℛ 𝒟 θ sb.
j < length ts⇩s⇩b ⟶ i≠ j⟶
ts⇩s⇩b ! j = (p, is, θ, sb, 𝒟, 𝒪, ℛ) ⟶
(all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)) ∩ (R ∪ L ∪ A) = {}"
proof -
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume j_bound: "j < length ts⇩s⇩b"
assume neq_i_j: "i ≠ j"
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j, θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume x_shared: "x ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
all_unshared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j) ∪
all_acquired (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
assume x_R_L_A: "x ∈ R ∪ L ∪ A"
have False
proof -
from x_shared all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
unshared_acquired_or_owned [OF sharing_consis [OF j_bound jth]]
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
all_unshared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
all_acquired_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)" "(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have "x ∈ all_acquired sb⇩j ∪ 𝒪⇩j "
by auto
moreover
from x_R_L_A R_owned L_subset
have "x ∈ all_acquired sb ∪ 𝒪⇩s⇩b"
by (auto simp add: sb Ghost⇩s⇩b)
moreover
note ownership_distinct [OF i_bound j_bound neq_i_j ts⇩s⇩b_i jth]
ultimately show False by blast
qed
}
thus ?thesis by blast
qed
{
fix j p⇩j is⇩j 𝒪⇩j ℛ⇩j 𝒟⇩j θ⇩j sb⇩j x
assume jth: "ts⇩s⇩b!j = (p⇩j,is⇩j,θ⇩j,sb⇩j,𝒟⇩j,𝒪⇩j,ℛ⇩j)"
assume j_bound: "j < length ts⇩s⇩b"
assume neq: "i ≠ j"
have "release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b ∪ R - L) ℛ⇩j
= release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)
(dom 𝒮⇩s⇩b) ℛ⇩j"
proof -
{
fix a
assume a_in: "a ∈ all_shared (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
have "(a ∈ (dom 𝒮⇩s⇩b ∪ R - L)) = (a ∈ dom 𝒮⇩s⇩b)"
proof -
from ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i jth]
have A_dist: "A ∩ (𝒪⇩j ∪ all_acquired sb⇩j) = {}"
by (auto simp add: sb Ghost⇩s⇩b)
from all_shared_acquired_or_owned [OF sharing_consis [OF j_bound jth]] a_in
all_shared_append [of "(takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb⇩j)"]
have a_in: "a ∈ 𝒪⇩j ∪ all_acquired sb⇩j"
by auto
with ownership_distinct [OF i_bound j_bound neq ts⇩s⇩b_i jth]
have "a ∉ (𝒪⇩s⇩b ∪ all_acquired sb)" by auto
with A_dist R_owned A_R A_shared_owned L_subset a_in
obtain "a ∉ R" and "a ∉ L"
by fastforce
then show ?thesis by auto
qed
}
then
show ?thesis
apply -
apply (rule release_all_shared_exchange)
apply auto
done
qed
}
note release_commute = this
from ownership_distinct_axioms have "ownership_distinct ts⇩s⇩b".
from sharing_consis_axioms have "sharing_consis 𝒮⇩s⇩b ts⇩s⇩b".
note share_commute = share_all_until_volatile_write_Ghost⇩s⇩b_commute [OF ‹ownership_distinct ts⇩s⇩b›
‹sharing_consis 𝒮⇩s⇩b ts⇩s⇩b› i_bound ts⇩s⇩b_i [simplified sb Ghost⇩s⇩b] dist_R_L_A]
have "(ts⇩s⇩b [i := (p⇩s⇩b,is⇩s⇩b, θ⇩s⇩b, sb', 𝒟⇩s⇩b, 𝒪⇩s⇩b ∪ A - R,augment_rels (dom 𝒮⇩s⇩b) R ℛ⇩s⇩b)],m⇩s⇩b,𝒮⇩s⇩b') ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' ts_sim ts_i is_sim 𝒟
apply (clarsimp simp add: Let_def nth_list_update sb suspends Ghost⇩s⇩b ℛ⇩s⇩b' 𝒮⇩s⇩b'
split: if_split_asm)
apply (rule conjI)
apply fastforce
apply clarsimp
apply (frule (2) release_commute)
apply clarsimp
apply auto
done
ultimately
show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs'
valid_program_history' valid'
m⇩s⇩b' 𝒮⇩s⇩b' ts⇩s⇩b'
by (auto simp del: fun_upd_apply simp add: 𝒪⇩s⇩b' ℛ⇩s⇩b')
qed
next
case (Program i p⇩s⇩b "is⇩s⇩b" θ⇩s⇩b sb 𝒟⇩s⇩b 𝒪⇩s⇩b ℛ⇩s⇩b p⇩s⇩b' mis)
then obtain
ts⇩s⇩b': "ts⇩s⇩b' = ts⇩s⇩b[i := (p⇩s⇩b', is⇩s⇩b@mis, θ⇩s⇩b, sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis], 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)]" and
i_bound: "i < length ts⇩s⇩b" and
ts⇩s⇩b_i: "ts⇩s⇩b ! i = (p⇩s⇩b, is⇩s⇩b,θ⇩s⇩b,sb, 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)" and
prog: "θ⇩s⇩b⊢ p⇩s⇩b →⇩p (p⇩s⇩b',mis)" and
𝒮⇩s⇩b': "𝒮⇩s⇩b'=𝒮⇩s⇩b" and
m⇩s⇩b': "m⇩s⇩b'=m⇩s⇩b"
by auto
from sim obtain
m: "m = flush_all_until_volatile_write ts⇩s⇩b m⇩s⇩b" and
𝒮: "𝒮 = share_all_until_volatile_write ts⇩s⇩b 𝒮⇩s⇩b" and
leq: "length ts⇩s⇩b = length ts" and
ts_sim: "∀i<length ts⇩s⇩b.
let (p, is⇩s⇩b, θ, sb, 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ) = ts⇩s⇩b ! i;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends ∧
𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts ! i =
(hd_prog p suspends,
is,
θ |` (dom θ - read_tmps suspends), (),
𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b,
release (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) (dom 𝒮⇩s⇩b) ℛ)"
by cases blast
from i_bound leq have i_bound': "i < length ts"
by auto
have split_sb: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb"
(is "sb = ?take_sb@?drop_sb")
by simp
from ts_sim [rule_format, OF i_bound] ts⇩s⇩b_i obtain suspends "is" 𝒟 where
suspends: "suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb" and
is_sim: "instrs suspends @ is⇩s⇩b = is @ prog_instrs suspends" and
𝒟: "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {})" and
ts_i: "ts ! i =
(hd_prog p⇩s⇩b suspends, is,
θ⇩s⇩b |` (dom θ⇩s⇩b - read_tmps suspends), (), 𝒟, acquired True ?take_sb 𝒪⇩s⇩b,
release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (auto simp add: Let_def)
from prog_step_preserves_valid [OF i_bound ts⇩s⇩b_i prog valid]
have valid': "valid ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
have valid_own': "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
show "outstanding_non_volatile_refs_owned_or_read_only 𝒮⇩s⇩b' ts⇩s⇩b'"
proof -
from outstanding_non_volatile_refs_owned_or_read_only [OF i_bound ts⇩s⇩b_i]
have "non_volatile_owned_or_read_only False 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"
by (auto simp add: non_volatile_owned_or_read_only_append)
from outstanding_non_volatile_refs_owned_or_read_only_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
qed
next
show "outstanding_volatile_writes_unowned_by_others ts⇩s⇩b'"
proof -
have out: "outstanding_refs is_volatile_Write⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) ⊆
outstanding_refs is_volatile_Write⇩s⇩b sb"
by (auto simp add: outstanding_refs_conv )
from outstanding_volatile_writes_unowned_by_others_store_buffer
[OF i_bound ts⇩s⇩b_i this]
show ?thesis by (simp add: ts⇩s⇩b' all_acquired_append)
qed
next
show "read_only_reads_unowned ts⇩s⇩b'"
proof -
have ro: "read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]))
⊆ read_only_reads (acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb) 𝒪⇩s⇩b)
(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb)"
apply (case_tac "outstanding_refs (is_volatile_Write⇩s⇩b) sb = {}")
apply (simp_all add: outstanding_vol_write_take_drop_appends
acquired_append read_only_reads_append )
done
have "𝒪⇩s⇩b ∪ all_acquired (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) ⊆ 𝒪⇩s⇩b ∪ all_acquired sb"
by (auto simp add: all_acquired_append)
from read_only_reads_unowned_nth_update [OF i_bound ts⇩s⇩b_i ro this]
show ?thesis
by (simp add: ts⇩s⇩b' )
qed
next
show "ownership_distinct ts⇩s⇩b'"
proof -
from ownership_distinct_instructions_read_value_store_buffer_independent
[OF i_bound ts⇩s⇩b_i, where sb'="(sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"]
show ?thesis by (simp add: ts⇩s⇩b' all_acquired_append)
qed
qed
from valid_last_prog [OF i_bound ts⇩s⇩b_i]
have last_prog: "last_prog p⇩s⇩b sb = p⇩s⇩b".
have valid_hist': "valid_history program_step ts⇩s⇩b'"
proof -
from valid_history [OF i_bound ts⇩s⇩b_i]
have "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b sb) sb".
from history_consistent_append_Prog⇩s⇩b [OF prog this last_prog]
have hist_consis': "history_consistent θ⇩s⇩b (hd_prog p⇩s⇩b' (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]))
(sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])".
from valid_history_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b')
qed
have valid_reads': "valid_reads m⇩s⇩b ts⇩s⇩b'"
proof -
from valid_reads [OF i_bound ts⇩s⇩b_i]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b sb" .
from reads_consistent_snoc_Prog⇩s⇩b [OF this]
have "reads_consistent False 𝒪⇩s⇩b m⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])".
from valid_reads_nth_update [OF i_bound this]
show ?thesis by (simp add: ts⇩s⇩b')
qed
have valid_sharing': "valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'"
proof (intro_locales)
from outstanding_non_volatile_writes_unshared [OF i_bound ts⇩s⇩b_i]
have "non_volatile_writes_unshared 𝒮⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"
by (auto simp add: non_volatile_writes_unshared_append)
from outstanding_non_volatile_writes_unshared_nth_update [OF i_bound this]
show "outstanding_non_volatile_writes_unshared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from sharing_consis [OF i_bound ts⇩s⇩b_i]
have "sharing_consistent 𝒮⇩s⇩b 𝒪⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"
by (auto simp add: sharing_consistent_append)
from sharing_consis_nth_update [OF i_bound this]
show "sharing_consis 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from read_only_unowned_nth_update [OF i_bound read_only_unowned [OF i_bound ts⇩s⇩b_i] ]
show "read_only_unowned 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b')
next
from unowned_shared_nth_update [OF i_bound ts⇩s⇩b_i subset_refl]
show "unowned_shared 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: ts⇩s⇩b' 𝒮⇩s⇩b')
next
from no_outstanding_write_to_read_only_memory [OF i_bound ts⇩s⇩b_i]
have "no_write_to_read_only_memory 𝒮⇩s⇩b (sb @ [Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"
by (simp add: no_write_to_read_only_memory_append)
from no_outstanding_write_to_read_only_memory_nth_update [OF i_bound this]
show "no_outstanding_write_to_read_only_memory 𝒮⇩s⇩b' ts⇩s⇩b'"
by (simp add: 𝒮⇩s⇩b' ts⇩s⇩b')
qed
have tmps_distinct': "tmps_distinct ts⇩s⇩b'"
proof (intro_locales)
from load_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_load_tmps is⇩s⇩b".
with distinct_load_tmps_prog_step [OF i_bound ts⇩s⇩b_i prog valid]
have "distinct_load_tmps (is⇩s⇩b@mis)"
by (auto simp add: distinct_load_tmps_append)
from load_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
next
from read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
have "distinct_read_tmps (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])"
by (simp add: distinct_read_tmps_append)
from read_tmps_distinct_nth_update [OF i_bound this]
show "read_tmps_distinct ts⇩s⇩b'"
by (simp add: ts⇩s⇩b')
next
from load_tmps_read_tmps_distinct [OF i_bound ts⇩s⇩b_i]
distinct_load_tmps_prog_step [OF i_bound ts⇩s⇩b_i prog valid]
have "load_tmps (is⇩s⇩b@mis) ∩ read_tmps (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) = {}"
by (auto simp add: read_tmps_append load_tmps_append)
from load_tmps_read_tmps_distinct_nth_update [OF i_bound this]
show "load_tmps_read_tmps_distinct ts⇩s⇩b'" by (simp add: ts⇩s⇩b')
qed
have valid_dd': "valid_data_dependency ts⇩s⇩b'"
proof -
from data_dependency_consistent_instrs [OF i_bound ts⇩s⇩b_i]
have "data_dependency_consistent_instrs (dom θ⇩s⇩b) is⇩s⇩b".
with valid_data_dependency_prog_step [OF i_bound ts⇩s⇩b_i prog valid]
load_tmps_write_tmps_distinct [OF i_bound ts⇩s⇩b_i]
obtain
"data_dependency_consistent_instrs (dom θ⇩s⇩b) (is⇩s⇩b@mis)"
"load_tmps (is⇩s⇩b@mis) ∩ ⋃(fst ` write_sops (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])) = {}"
by (force simp add: load_tmps_append data_dependency_consistent_instrs_append
write_sops_append)
from valid_data_dependency_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
have load_tmps_fresh': "load_tmps_fresh ts⇩s⇩b'"
proof -
from load_tmps_fresh [OF i_bound ts⇩s⇩b_i]
load_tmps_fresh_prog_step [OF i_bound ts⇩s⇩b_i prog valid]
have "load_tmps (is⇩s⇩b@mis) ∩ dom θ⇩s⇩b = {}"
by (auto simp add: load_tmps_append)
from load_tmps_fresh_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
have enough_flushs': "enough_flushs ts⇩s⇩b'"
proof -
from clean_no_outstanding_volatile_Write⇩s⇩b [OF i_bound ts⇩s⇩b_i]
have "¬ 𝒟⇩s⇩b ⟶ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) = {}"
by (auto simp add: outstanding_refs_append)
from enough_flushs_nth_update [OF i_bound this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
have valid_sops': "valid_sops ts⇩s⇩b'"
proof -
from valid_store_sops [OF i_bound ts⇩s⇩b_i] valid_sops_prog_step [OF prog]
valid_implies_valid_prog[OF i_bound ts⇩s⇩b_i valid]
have valid_store: "∀sop∈store_sops (is⇩s⇩b@mis). valid_sop sop"
by (auto simp add: store_sops_append)
from valid_write_sops [OF i_bound ts⇩s⇩b_i]
have "∀sop∈write_sops (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]). valid_sop sop"
by (auto simp add: write_sops_append)
from valid_sops_nth_update [OF i_bound this valid_store]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
have valid_program_history':"valid_program_history ts⇩s⇩b'"
proof -
from valid_program_history [OF i_bound ts⇩s⇩b_i]
have "causal_program_history is⇩s⇩b sb" .
from causal_program_history_Prog⇩s⇩b [OF this]
have causal': "causal_program_history (is⇩s⇩b@mis) (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])".
from last_prog_append_Prog⇩s⇩b
have "last_prog p⇩s⇩b' (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) = p⇩s⇩b'".
from valid_program_history_nth_update [OF i_bound causal' this]
show ?thesis
by (simp add: ts⇩s⇩b')
qed
show ?thesis
proof (cases "outstanding_refs is_volatile_Write⇩s⇩b sb = {}")
case True
from True have flush_all: "takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = sb"
by (auto simp add: outstanding_refs_conv)
from True have suspend_nothing: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = []"
by (auto simp add: outstanding_refs_conv)
hence suspends_empty: "suspends = []"
by (simp add: suspends)
from suspends_empty is_sim have "is": "is = is⇩s⇩b"
by (simp)
from ts_i have ts_i: "ts ! i = (p⇩s⇩b, is⇩s⇩b, θ⇩s⇩b, (),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)"
by (simp add: suspends_empty "is")
from direct_computation.Program [OF i_bound' ts_i prog]
have "(ts,m,𝒮) ⇒⇩d (ts[i := (p⇩s⇩b', is⇩s⇩b @ mis, θ⇩s⇩b, (),
𝒟, acquired True ?take_sb 𝒪⇩s⇩b,release ?take_sb (dom 𝒮⇩s⇩b) ℛ⇩s⇩b)], m, 𝒮)".
moreover
note flush_commute = flush_all_until_volatile_write_append_Prog⇩s⇩b_commute [OF i_bound ts⇩s⇩b_i]
from True
have suspend_nothing':
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])) = []"
by (auto simp add: outstanding_refs_conv)
note share_commute =
share_all_until_volatile_write_update_sb [OF share_append_Prog⇩s⇩b i_bound ts⇩s⇩b_i]
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b [i := (p⇩s⇩b',is⇩s⇩b@mis, θ⇩s⇩b, sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis], 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)],
m⇩s⇩b,𝒮⇩s⇩b') ∼
(ts[i:=(p⇩s⇩b', is⇩s⇩b @ mis, θ⇩s⇩b, (), 𝒟,
acquired True (takeWhile (Not ∘ is_volatile_Write⇩s⇩b)
(sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])) 𝒪⇩s⇩b,
release (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) (dom 𝒮⇩s⇩b) ℛ⇩s⇩b )],m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' ts_sim ts_i 𝒟'
apply (clarsimp simp add: Let_def nth_list_update flush_all suspend_nothing' Prog⇩s⇩b 𝒮⇩s⇩b'
release_append_Prog⇩s⇩b release_append
split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' m⇩s⇩b'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing'
valid_program_history' valid'
𝒮⇩s⇩b' ts⇩s⇩b'
by (auto simp del: fun_upd_apply simp add: acquired_append_Prog⇩s⇩b release_append_Prog⇩s⇩b release_append flush_all)
next
case False
then obtain r where r_in: "r ∈ set sb" and volatile_r: "is_volatile_Write⇩s⇩b r"
by (auto simp add: outstanding_refs_conv)
from takeWhile_dropWhile_real_prefix
[OF r_in, of "(Not ∘ is_volatile_Write⇩s⇩b)", simplified, OF volatile_r]
obtain a' v' sb'' sop' A' L' R' W' where
sb_split: "sb = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
and
drop: "dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
apply (auto)
subgoal for y
apply (case_tac y)
apply auto
done
done
from drop suspends have suspends': "suspends = Write⇩s⇩b True a' sop' v' A' L' R' W'# sb''"
by simp
have "(ts, m, 𝒮) ⇒⇩d⇧* (ts, m, 𝒮)" by auto
moreover
note flush_commute= flush_all_until_volatile_write_append_Prog⇩s⇩b_commute [OF i_bound ts⇩s⇩b_i]
have "Write⇩s⇩b True a' sop' v' A' L' R' W' ∈ set sb"
by (subst sb_split) auto
from dropWhile_append1 [OF this, of "(Not ∘ is_volatile_Write⇩s⇩b)"]
have drop_app_comm:
"(dropWhile (Not ∘ is_volatile_Write⇩s⇩b) (sb @ [Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis])) =
dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb @ [Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]"
by simp
note share_commute =
share_all_until_volatile_write_update_sb [OF share_append_Prog⇩s⇩b i_bound ts⇩s⇩b_i]
from 𝒟
have 𝒟': "𝒟⇩s⇩b = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b (sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis]) ≠ {})"
by (auto simp: outstanding_refs_append)
have "(ts⇩s⇩b [i := (p⇩s⇩b',is⇩s⇩b@mis,θ⇩s⇩b, sb@[Prog⇩s⇩b p⇩s⇩b p⇩s⇩b' mis], 𝒟⇩s⇩b, 𝒪⇩s⇩b,ℛ⇩s⇩b)],
m⇩s⇩b,𝒮⇩s⇩b') ∼
(ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp add: m flush_commute)
apply (clarsimp simp add: 𝒮 𝒮⇩s⇩b' share_commute)
using leq
apply simp
using i_bound i_bound' ts_sim ts_i is_sim suspends suspends' [simplified suspends] 𝒟'
apply (clarsimp simp add: Let_def nth_list_update Prog⇩s⇩b
drop_app_comm instrs_append prog_instrs_append
read_tmps_append hd_prog_append_Prog⇩s⇩b acquired_append_Prog⇩s⇩b release_append_Prog⇩s⇩b release_append 𝒮⇩s⇩b'
split: if_split_asm)
done
ultimately show ?thesis
using valid_own' valid_hist' valid_reads' valid_sharing' tmps_distinct' m⇩s⇩b'
valid_dd' valid_sops' load_tmps_fresh' enough_flushs' valid_sharing'
valid_program_history' valid'
𝒮⇩s⇩b' ts⇩s⇩b'
by (auto simp del: fun_upd_apply)
qed
qed
qed
theorem (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_history_steps:
assumes step_sb: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h⇧* (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b')"
assumes valid_own: "valid_ownership 𝒮⇩s⇩b ts⇩s⇩b"
assumes valid_sb_reads: "valid_reads m⇩s⇩b ts⇩s⇩b"
assumes valid_hist: "valid_history program_step ts⇩s⇩b"
assumes valid_sharing: "valid_sharing 𝒮⇩s⇩b ts⇩s⇩b"
assumes tmps_distinct: "tmps_distinct ts⇩s⇩b"
assumes valid_sops: "valid_sops ts⇩s⇩b"
assumes valid_dd: "valid_data_dependency ts⇩s⇩b"
assumes load_tmps_fresh: "load_tmps_fresh ts⇩s⇩b"
assumes enough_flushs: "enough_flushs ts⇩s⇩b"
assumes valid_program_history: "valid_program_history ts⇩s⇩b"
assumes valid: "valid ts⇩s⇩b"
shows "⋀ts 𝒮 m. (ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮) ⟹ safe_reach_direct safe_delayed (ts,m,𝒮) ⟹
valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b' ∧ valid_reads m⇩s⇩b' ts⇩s⇩b' ∧ valid_history program_step ts⇩s⇩b' ∧
valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b' ∧ tmps_distinct ts⇩s⇩b' ∧ valid_data_dependency ts⇩s⇩b' ∧
valid_sops ts⇩s⇩b' ∧ load_tmps_fresh ts⇩s⇩b' ∧ enough_flushs ts⇩s⇩b' ∧
valid_program_history ts⇩s⇩b' ∧ valid ts⇩s⇩b' ∧
(∃ts' m' 𝒮'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧ (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b') ∼ (ts',m',𝒮'))"
using step_sb valid_own valid_sb_reads valid_hist valid_sharing tmps_distinct valid_sops
valid_dd load_tmps_fresh enough_flushs valid_program_history valid
proof (induct rule: converse_rtranclp_induct_sbh_steps)
case refl thus ?case
by auto
next
case (step ts⇩s⇩b m⇩s⇩b 𝒮⇩s⇩b ts⇩s⇩b'' m⇩s⇩b'' 𝒮⇩s⇩b'')
note first = ‹(ts⇩s⇩b, m⇩s⇩b, 𝒮⇩s⇩b) ⇒⇩s⇩b⇩h (ts⇩s⇩b'', m⇩s⇩b'', 𝒮⇩s⇩b'')›
note sim = ‹(ts⇩s⇩b, m⇩s⇩b, 𝒮⇩s⇩b) ∼ (ts, m, 𝒮)›
note safe_reach = ‹safe_reach_direct safe_delayed (ts, m, 𝒮)›
note valid_own = ‹valid_ownership 𝒮⇩s⇩b ts⇩s⇩b›
note valid_reads = ‹valid_reads m⇩s⇩b ts⇩s⇩b›
note valid_hist = ‹valid_history program_step ts⇩s⇩b›
note valid_sharing = ‹valid_sharing 𝒮⇩s⇩b ts⇩s⇩b›
note tmps_distinct = ‹tmps_distinct ts⇩s⇩b›
note valid_sops = ‹valid_sops ts⇩s⇩b›
note valid_dd = ‹valid_data_dependency ts⇩s⇩b›
note load_tmps_fresh = ‹load_tmps_fresh ts⇩s⇩b›
note enough_flushs = ‹enough_flushs ts⇩s⇩b›
note valid_prog_hist = ‹valid_program_history ts⇩s⇩b›
note valid = ‹valid ts⇩s⇩b›
from concurrent_direct_steps_simulates_store_buffer_history_step [OF first
valid_own valid_reads valid_hist valid_sharing tmps_distinct valid_sops valid_dd
load_tmps_fresh enough_flushs valid_prog_hist valid sim safe_reach]
obtain ts'' m'' 𝒮'' where
valid_own'': "valid_ownership 𝒮⇩s⇩b'' ts⇩s⇩b''" and
valid_reads'': "valid_reads m⇩s⇩b'' ts⇩s⇩b''" and
valid_hist'': "valid_history program_step ts⇩s⇩b''" and
valid_sharing'': "valid_sharing 𝒮⇩s⇩b'' ts⇩s⇩b''" and
tmps_dist'': "tmps_distinct ts⇩s⇩b''" and
valid_dd'': "valid_data_dependency ts⇩s⇩b''" and
valid_sops'': "valid_sops ts⇩s⇩b''" and
load_tmps_fresh'': "load_tmps_fresh ts⇩s⇩b''" and
enough_flushs'': "enough_flushs ts⇩s⇩b''" and
valid_prog_hist'': "valid_program_history ts⇩s⇩b''"and
valid'': "valid ts⇩s⇩b''" and
steps: "(ts, m, 𝒮) ⇒⇩d⇧* (ts'', m'', 𝒮'')" and
sim: "(ts⇩s⇩b'', m⇩s⇩b'',𝒮⇩s⇩b'') ∼ (ts'', m'',𝒮'')"
by blast
from step.hyps (3) [OF sim safe_reach_steps [OF safe_reach steps] valid_own'' valid_reads'' valid_hist'' valid_sharing''
tmps_dist'' valid_sops'' valid_dd'' load_tmps_fresh'' enough_flushs'' valid_prog_hist'' valid'' ]
obtain ts' m' 𝒮' where
valid: "valid_ownership 𝒮⇩s⇩b' ts⇩s⇩b'" "valid_reads m⇩s⇩b' ts⇩s⇩b'" "valid_history program_step ts⇩s⇩b'"
"valid_sharing 𝒮⇩s⇩b' ts⇩s⇩b'" "tmps_distinct ts⇩s⇩b'" "valid_data_dependency ts⇩s⇩b'"
"valid_sops ts⇩s⇩b'" "load_tmps_fresh ts⇩s⇩b'" "enough_flushs ts⇩s⇩b'"
"valid_program_history ts⇩s⇩b'" "valid ts⇩s⇩b'" and
last: "(ts'', m'', 𝒮'') ⇒⇩d⇧* (ts', m', 𝒮')" and
sim': "(ts⇩s⇩b', m⇩s⇩b',𝒮⇩s⇩b') ∼ (ts', m',𝒮')"
by blast
note steps also note last
finally show ?case
using valid sim'
by blast
qed
sublocale initial⇩s⇩b ⊆ tmps_distinct ..
locale xvalid_program_progress = program_progress + xvalid_program
theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_history_execution:
assumes exec_sb: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h⇧* (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b')"
assumes init: "initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b"
assumes valid: "valid ts⇩s⇩b"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "∃ts' m' 𝒮'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧
(ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b') ∼ (ts',m',𝒮')"
proof -
from init interpret ini: initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b .
from safe_free_flowing_implies_safe_delayed' [OF init sim safe]
have safe_delayed: "safe_reach_direct safe_delayed (ts, m, 𝒮)".
from local.ini.valid_ownership_axioms have "valid_ownership 𝒮⇩s⇩b ts⇩s⇩b" .
from local.ini.valid_reads_axioms have "valid_reads m⇩s⇩b ts⇩s⇩b".
from local.ini.valid_history_axioms have "valid_history program_step ts⇩s⇩b".
from local.ini.valid_sharing_axioms have "valid_sharing 𝒮⇩s⇩b ts⇩s⇩b".
from local.ini.tmps_distinct_axioms have "tmps_distinct ts⇩s⇩b".
from local.ini.valid_sops_axioms have "valid_sops ts⇩s⇩b".
from local.ini.valid_data_dependency_axioms have "valid_data_dependency ts⇩s⇩b".
from local.ini.load_tmps_fresh_axioms have "load_tmps_fresh ts⇩s⇩b".
from local.ini.enough_flushs_axioms have "enough_flushs ts⇩s⇩b".
from local.ini.valid_program_history_axioms have "valid_program_history ts⇩s⇩b".
from concurrent_direct_steps_simulates_store_buffer_history_steps [OF exec_sb
‹valid_ownership 𝒮⇩s⇩b ts⇩s⇩b›
‹valid_reads m⇩s⇩b ts⇩s⇩b› ‹valid_history program_step ts⇩s⇩b›
‹valid_sharing 𝒮⇩s⇩b ts⇩s⇩b› ‹tmps_distinct ts⇩s⇩b› ‹valid_sops ts⇩s⇩b›
‹valid_data_dependency ts⇩s⇩b› ‹load_tmps_fresh ts⇩s⇩b› ‹enough_flushs ts⇩s⇩b›
‹valid_program_history ts⇩s⇩b› valid sim safe_delayed]
show ?thesis by auto
qed
lemma filter_is_Write⇩s⇩b_Cons_Write⇩s⇩b: "filter is_Write⇩s⇩b xs = Write⇩s⇩b volatile a sop v A L R W#ys
⟹ ∃rs rws. (∀r ∈ set rs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r) ∧
xs=rs@Write⇩s⇩b volatile a sop v A L R W#rws ∧ ys=filter is_Write⇩s⇩b rws"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
note feq = ‹filter is_Write⇩s⇩b (x#xs) = Write⇩s⇩b volatile a sop v A L R W# ys›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile' a' sop' v' A' L' R' W')
with feq obtain "volatile'=volatile" "a'=a" "v'=v" "sop'=sop" "A'=A" "L'=L" "R'=R" "W'=W"
"ys = filter is_Write⇩s⇩b xs"
by auto
thus ?thesis
apply -
apply (rule_tac x="[]" in exI)
apply (rule_tac x="xs" in exI)
apply (simp add: Write⇩s⇩b)
done
next
case (Read⇩s⇩b volatile' a' t' v')
from feq have "filter is_Write⇩s⇩b xs = Write⇩s⇩b volatile a sop v A L R W#ys"
by (simp add: Read⇩s⇩b)
from Cons.hyps [OF this] obtain rs rws where
"∀r ∈ set rs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r" and
"xs=rs @ Write⇩s⇩b volatile a sop v A L R W# rws" and
"ys=filter is_Write⇩s⇩b rws"
by clarsimp
then show ?thesis
apply -
apply (rule_tac x="Read⇩s⇩b volatile' a' t' v'#rs" in exI)
apply (rule_tac x="rws" in exI)
apply (simp add: Read⇩s⇩b)
done
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
from feq have "filter is_Write⇩s⇩b xs = Write⇩s⇩b volatile a sop v A L R W#ys"
by (simp add: Prog⇩s⇩b)
from Cons.hyps [OF this] obtain rs rws where
"∀r ∈ set rs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r" and
"xs=rs @ Write⇩s⇩b volatile a sop v A L R W# rws" and
"ys=filter is_Write⇩s⇩b rws"
by clarsimp
then show ?thesis
apply -
apply (rule_tac x="Prog⇩s⇩b p⇩1 p⇩2 mis#rs" in exI)
apply (rule_tac x="rws" in exI)
apply (simp add: Prog⇩s⇩b)
done
next
case (Ghost⇩s⇩b A' L' R' W')
from feq have "filter is_Write⇩s⇩b xs = Write⇩s⇩b volatile a sop v A L R W # ys"
by (simp add: Ghost⇩s⇩b)
from Cons.hyps [OF this] obtain rs rws where
"∀r ∈ set rs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r" and
"xs=rs @ Write⇩s⇩b volatile a sop v A L R W# rws" and
"ys=filter is_Write⇩s⇩b rws"
by clarsimp
then show ?thesis
apply -
apply (rule_tac x="Ghost⇩s⇩b A' L' R' W'#rs" in exI)
apply (rule_tac x="rws" in exI)
apply (simp add: Ghost⇩s⇩b)
done
qed
qed
lemma filter_is_Write⇩s⇩b_empty: "filter is_Write⇩s⇩b xs = []
⟹ (∀r ∈ set xs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r)"
proof (induct xs)
case Nil thus ?case by simp
next
case (Cons x xs)
note feq = ‹filter is_Write⇩s⇩b (x#xs) = []›
show ?case
proof (cases x)
case (Write⇩s⇩b volatile' a' v')
with feq have False
by simp
thus ?thesis ..
next
case (Read⇩s⇩b a' v')
from feq have "filter is_Write⇩s⇩b xs = []"
by (simp add: Read⇩s⇩b)
from Cons.hyps [OF this] obtain
"∀r ∈ set xs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r"
by clarsimp
then show ?thesis
by (simp add: Read⇩s⇩b)
next
case (Prog⇩s⇩b p⇩2 p⇩2 mis)
from feq have "filter is_Write⇩s⇩b xs = []"
by (simp add: Prog⇩s⇩b)
from Cons.hyps [OF this] obtain
"∀r ∈ set xs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r"
by clarsimp
then show ?thesis
by (simp add: Prog⇩s⇩b)
next
case (Ghost⇩s⇩b A' L' R' W')
from feq have "filter is_Write⇩s⇩b xs = []"
by (simp add: Ghost⇩s⇩b)
from Cons.hyps [OF this] obtain
"∀r ∈ set xs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r"
by clarsimp
then show ?thesis
by (simp add: Ghost⇩s⇩b)
qed
qed
lemma flush_reads_program: "⋀𝒪 𝒮 ℛ .
∀r ∈ set sb. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r ⟹
∃𝒪' ℛ' 𝒮'. (m,sb,𝒪,ℛ,𝒮) →⇩f⇧* (m,[],𝒪',ℛ',𝒮')"
proof (induct sb)
case Nil thus ?case by auto
next
case (Cons x sb)
note ‹∀r∈set (x # sb). is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r›
then obtain x: "is_Read⇩s⇩b x ∨ is_Prog⇩s⇩b x ∨ is_Ghost⇩s⇩b x" and sb: "∀r∈set sb. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r"
by (cases x) auto
{
assume "is_Read⇩s⇩b x"
then obtain volatile a t v where x: "x=Read⇩s⇩b volatile a t v"
by (cases x) auto
have "(m,Read⇩s⇩b volatile a t v#sb,𝒪,ℛ,𝒮) →⇩f (m,sb,𝒪,ℛ,𝒮)"
by (rule Read⇩s⇩b)
also
from Cons.hyps [OF sb] obtain 𝒪' 𝒮' acq' ℛ'
where "(m, sb,𝒪,ℛ,𝒮) →⇩f⇧* (m, [],𝒪',ℛ',𝒮')" by blast
finally
have ?case
by (auto simp add: x)
}
moreover
{
assume "is_Prog⇩s⇩b x"
then obtain p⇩1 p⇩2 mis where x: "x=Prog⇩s⇩b p⇩1 p⇩2 mis"
by (cases x) auto
have "(m,Prog⇩s⇩b p⇩1 p⇩2 mis#sb,𝒪,ℛ,𝒮) →⇩f (m,sb,𝒪,ℛ,𝒮)"
by (rule Prog⇩s⇩b)
also
from Cons.hyps [OF sb] obtain 𝒪' ℛ' 𝒮' acq'
where "(m, sb,𝒪,ℛ,𝒮) →⇩f⇧* (m, [],𝒪',ℛ',𝒮')" by blast
finally
have ?case
by (auto simp add: x)
}
moreover
{
assume "is_Ghost⇩s⇩b x"
then obtain A L R W where x: "x=Ghost⇩s⇩b A L R W"
by (cases x) auto
have "(m,Ghost⇩s⇩b A L R W#sb,𝒪,ℛ,𝒮) →⇩f (m,sb,𝒪 ∪ A - R,augment_rels (dom 𝒮) R ℛ,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (rule Ghost)
also
from Cons.hyps [OF sb] obtain 𝒪' 𝒮' ℛ' acq'
where "(m, sb,𝒪 ∪ A - R ,augment_rels (dom 𝒮) R ℛ,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L) →⇩f⇧* (m, [],𝒪',ℛ',𝒮')" by blast
finally
have ?case
by (auto simp add: x)
}
ultimately show ?case
using x by blast
qed
lemma flush_progress: "∃m' 𝒪' 𝒮' ℛ'. (m,r#sb,𝒪,ℛ,𝒮) →⇩f (m',sb,𝒪',ℛ',𝒮')"
proof (cases r)
case (Write⇩s⇩b volatile a sop v A L R W)
from flush_step.Write⇩s⇩b [OF refl refl refl, of m volatile a sop v A L R W sb 𝒪 ℛ 𝒮]
show ?thesis
by (auto simp add: Write⇩s⇩b)
next
case (Read⇩s⇩b volatile a t v)
from flush_step.Read⇩s⇩b [of m volatile a t v sb 𝒪 ℛ 𝒮]
show ?thesis
by (auto simp add: Read⇩s⇩b)
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
from flush_step.Prog⇩s⇩b [of m p⇩1 p⇩2 mis sb 𝒪 ℛ 𝒮]
show ?thesis
by (auto simp add: Prog⇩s⇩b)
next
case (Ghost⇩s⇩b A L R W)
from flush_step.Ghost [of m A L R W sb 𝒪 ℛ 𝒮]
show ?thesis
by (auto simp add: Ghost⇩s⇩b)
qed
lemma flush_empty:
assumes steps: "(m, sb,𝒪,ℛ, 𝒮) →⇩f⇧* (m', sb',𝒪',ℛ',𝒮')"
shows "sb=[] ⟹ m'=m ∧ sb'=[] ∧ 𝒪'=𝒪 ∧ ℛ'=ℛ ∧ 𝒮'=𝒮 "
using steps
apply (induct rule: converse_rtranclp_induct5)
apply (auto elim: flush_step.cases)
done
lemma flush_append:
assumes steps: "(m, sb,𝒪,ℛ,𝒮) →⇩f⇧* (m', sb',𝒪',ℛ',𝒮')"
shows "⋀xs. (m, sb@xs,𝒪,ℛ,𝒮) →⇩f⇧* (m', sb'@xs,𝒪',ℛ',𝒮')"
using steps
proof (induct rule: converse_rtranclp_induct5)
case refl thus ?case by auto
next
case (step m sb 𝒪 ℛ 𝒮 m'' sb'' 𝒪'' ℛ'' 𝒮'')
note first= ‹(m,sb,𝒪,ℛ,𝒮) →⇩f (m'',sb'',𝒪'',ℛ'',𝒮'')›
note rest = ‹(m'', sb'',𝒪'',ℛ'',𝒮'') →⇩f⇧* (m', sb',𝒪',ℛ',𝒮')›
from step.hyps (3) have append_rest: "(m'', sb''@xs,𝒪'',ℛ'',𝒮'') →⇩f⇧* (m', sb'@xs,𝒪',ℛ',𝒮')".
from first show ?case
proof (cases)
case (Write⇩s⇩b volatile A R W L a sop v)
then obtain sb: "sb=Write⇩s⇩b volatile a sop v A L R W#sb''" and m'': "m''=m(a:=v)" and
𝒪'': "𝒪''=(if volatile then 𝒪 ∪ A - R else 𝒪)" and
ℛ'': "ℛ''=(if volatile then Map.empty else ℛ)" and
𝒮'': "𝒮''=(if volatile then 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L else 𝒮)"
by auto
have "(m,Write⇩s⇩b volatile a sop v A L R W#sb''@xs,𝒪,ℛ,𝒮) →⇩f
(m(a:=v),sb''@xs,if volatile then 𝒪 ∪ A - R else 𝒪,if volatile then Map.empty else ℛ,
if volatile then 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L else 𝒮)"
apply (rule flush_step.Write⇩s⇩b)
apply auto
done
hence "(m,sb@xs,𝒪,ℛ,𝒮) →⇩f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'')
also note append_rest
finally show ?thesis .
next
case (Read⇩s⇩b volatile a t v)
then obtain sb: "sb=Read⇩s⇩b volatile a t v #sb''" and m'': "m''=m"
and 𝒪'': "𝒪''=𝒪" and 𝒮'': "𝒮''=𝒮" and ℛ'': "ℛ''=ℛ"
by auto
have "(m,Read⇩s⇩b volatile a t v#sb''@xs,𝒪,ℛ,𝒮) →⇩f (m,sb''@xs,𝒪,ℛ,𝒮)"
by (rule flush_step.Read⇩s⇩b)
hence "(m,sb@xs,𝒪,ℛ,𝒮) →⇩f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' )
also note append_rest
finally show ?thesis .
next
case (Prog⇩s⇩b p⇩1 p⇩2 mis)
then obtain sb: "sb=Prog⇩s⇩b p⇩1 p⇩2 mis#sb''" and m'': "m''=m"
and 𝒪'': "𝒪''=𝒪" and 𝒮'': "𝒮''=𝒮" and ℛ'': "ℛ''=ℛ"
by auto
have "(m,Prog⇩s⇩b p⇩1 p⇩2 mis#sb''@xs,𝒪,ℛ,𝒮) →⇩f (m,sb''@xs,𝒪,ℛ,𝒮)"
by (rule flush_step.Prog⇩s⇩b)
hence "(m,sb@xs,𝒪,ℛ,𝒮) →⇩f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' )
also note append_rest
finally show ?thesis .
next
case (Ghost A L R W)
then obtain sb: "sb=Ghost⇩s⇩b A L R W#sb''" and m'': "m''=m"
and 𝒪'': "𝒪''=𝒪 ∪ A - R" and 𝒮'': "𝒮''=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L" and
ℛ'': "ℛ''=augment_rels (dom 𝒮) R ℛ"
by auto
have "(m,Ghost⇩s⇩b A L R W#sb''@xs,𝒪,ℛ,𝒮) →⇩f (m,sb''@xs,𝒪 ∪ A - R,augment_rels (dom 𝒮) R ℛ,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (rule flush_step.Ghost)
hence "(m,sb@xs,𝒪,ℛ,𝒮) →⇩f (m'',sb''@xs,𝒪'',ℛ'',𝒮'')"
by (simp add: sb m'' 𝒪'' ℛ'' 𝒮'' )
also note append_rest
finally show ?thesis .
qed
qed
lemmas store_buffer_step_induct =
store_buffer_step.induct [split_format (complete),
consumes 1, case_names SBWrite⇩s⇩b]
theorem flush_simulates_filter_writes:
assumes step: "(m,sb,𝒪,ℛ,𝒮) →⇩w (m',sb',𝒪',ℛ',𝒮')"
shows "⋀sb⇩h 𝒪⇩h ℛ⇩h 𝒮⇩h. sb=filter is_Write⇩s⇩b sb⇩h
⟹
∃sb⇩h' 𝒪⇩h' ℛ⇩h' 𝒮⇩h'. (m,sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m',sb⇩h',𝒪⇩h',ℛ⇩h',𝒮⇩h') ∧
sb'=filter is_Write⇩s⇩b sb⇩h' ∧ (sb'=[] ⟶ sb⇩h'=[])"
using step
proof (induct rule: store_buffer_step_induct)
case (SBWrite⇩s⇩b m volatile a D f v A L R W sb 𝒪 ℛ 𝒮)
note filter_Write⇩s⇩b = ‹Write⇩s⇩b volatile a (D,f) v A L R W# sb = filter is_Write⇩s⇩b sb⇩h›
from filter_is_Write⇩s⇩b_Cons_Write⇩s⇩b [OF filter_Write⇩s⇩b [symmetric]]
obtain rs rws where
rs_reads: "∀r∈set rs. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r" and
sb⇩h: "sb⇩h = rs @ Write⇩s⇩b volatile a (D,f) v A L R W# rws" and
sb: "sb = filter is_Write⇩s⇩b rws"
by blast
from flush_reads_program [OF rs_reads] obtain 𝒪⇩h' ℛ⇩h' 𝒮⇩h' acq⇩h'
where "(m, rs,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m, [],𝒪⇩h',ℛ⇩h',𝒮⇩h')" by blast
from flush_append [OF this]
have "(m, rs@Write⇩s⇩b volatile a (D,f) v A L R W# rws,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧*
(m, Write⇩s⇩b volatile a (D,f) v A L R W# rws,𝒪⇩h',ℛ⇩h',𝒮⇩h')"
by simp
also
from flush_step.Write⇩s⇩b [OF refl refl refl, of m volatile a "(D,f)" v A L R W rws 𝒪⇩h' ℛ⇩h' 𝒮⇩h']
obtain 𝒪⇩h'' ℛ⇩h'' 𝒮⇩h''
where "(m, Write⇩s⇩b volatile a (D,f) v A L R W# rws,𝒪⇩h',ℛ⇩h',𝒮⇩h') →⇩f (m(a:=v), rws, 𝒪⇩h'',ℛ⇩h'',𝒮⇩h'')"
by auto
finally have steps: "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m(a:=v), rws,𝒪⇩h'',ℛ⇩h'',𝒮⇩h'')"
by (simp add: sb⇩h sb)
show ?case
proof (cases "sb")
case Cons
with steps sb show ?thesis
by fastforce
next
case Nil
from filter_is_Write⇩s⇩b_empty [OF sb [simplified Nil, symmetric]]
have "∀r∈set rws. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r".
from flush_reads_program [OF this] obtain 𝒪⇩h''' ℛ⇩h''' 𝒮⇩h''' acq⇩h'''
where "(m(a:=v), rws,𝒪⇩h'',ℛ⇩h'',𝒮⇩h'') →⇩f⇧* (m(a:=v), [],𝒪⇩h''',ℛ⇩h''',𝒮⇩h''')" by blast
with steps
have "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m(a:=v), [],𝒪⇩h''',ℛ⇩h''',𝒮⇩h''')" by force
with sb Nil show ?thesis by fastforce
qed
qed
lemma bufferd_val_filter_is_Write⇩s⇩b_eq_ext:
"buffered_val (filter is_Write⇩s⇩b sb) a = buffered_val sb a"
by (induct sb) (auto split: memref.splits)
lemma bufferd_val_filter_is_Write⇩s⇩b_eq:
"buffered_val (filter is_Write⇩s⇩b sb) = buffered_val sb"
by (rule ext) (rule bufferd_val_filter_is_Write⇩s⇩b_eq_ext)
lemma outstanding_refs_is_volatile_Write⇩s⇩b_filter_writes:
"outstanding_refs is_volatile_Write⇩s⇩b (filter is_Write⇩s⇩b xs) =
outstanding_refs is_volatile_Write⇩s⇩b xs"
by (induct xs) (auto simp add: is_volatile_Write⇩s⇩b_def split: memref.splits)
subsection ‹Simulation of Store Buffer Machine without History by Store Buffer Machine with History›
theorem (in valid_program) concurrent_history_steps_simulates_store_buffer_step:
assumes step_sb: "(ts,m,𝒮) ⇒⇩s⇩b (ts',m',𝒮')"
assumes sim: "ts ∼⇩h ts⇩h"
shows "∃ts⇩h' 𝒮⇩h'. (ts⇩h,m,𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m',𝒮⇩h') ∧ ts' ∼⇩h ts⇩h'"
proof -
interpret sbh_computation:
computation sbh_memop_step flush_step program_step
"λp p' is sb. sb @ [Prog⇩s⇩b p p' is]" .
from step_sb
show ?thesis
proof (cases rule: concurrent_step_cases)
case (Memop i _ p "is" θ sb 𝒟 𝒪 ℛ _ _ is' θ' sb' _ 𝒟' 𝒪' ℛ')
then obtain
ts': "ts' = ts[i := (p, is', θ', sb', 𝒟', 𝒪',ℛ')]" and
i_bound: "i < length ts" and
ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ)" and
step_sb: "(is, θ, sb, m, 𝒟, 𝒪, ℛ,𝒮) →⇩s⇩b
(is', θ', sb', m', 𝒟', 𝒪', ℛ',𝒮')"
by auto
from sim obtain
lts_eq: "length ts = length ts⇩h" and
sim_loc: "∀i < length ts. (∃𝒪' 𝒟' ℛ'.
let (p,is, θ, sb,𝒟, 𝒪,ℛ) = ts⇩h!i in
ts!i=(p,is, θ, filter is_Write⇩s⇩b sb,𝒟',𝒪',ℛ') ∧
(filter is_Write⇩s⇩b sb = [] ⟶ sb=[]))"
by cases (auto)
from lts_eq i_bound have i_bound': "i < length ts⇩h"
by simp
from step_sb
show ?thesis
proof (cases)
case (SBReadBuffered a v volatile t)
then obtain
"is": "is = Read volatile a t#is'" and
𝒪': "𝒪'=𝒪" and
𝒮': "𝒮'=𝒮" and
ℛ': "ℛ'=ℛ" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ(t↦v)" and
sb': "sb' = sb" and
buf_val: "buffered_val sb a = Some v"
by auto
from sim_loc [rule_format, OF i_bound] ts_i "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Read volatile a t#is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h" and
sb_empty: "filter is_Write⇩s⇩b sb⇩h = [] ⟶ sb⇩h=[]"
by (auto simp add: Let_def)
from buf_val
have buf_val': "buffered_val sb⇩h a = Some v"
by (simp add: bufferd_val_filter_is_Write⇩s⇩b_eq sb)
let ?ts⇩h_i' = "(p, is', θ(t ↦ v), sb⇩h @ [Read⇩s⇩b volatile a t v], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)"
let ?ts⇩h' = "ts⇩h[i := ?ts⇩h_i']"
from sbh_memop_step.SBHReadBuffered [OF buf_val']
have "(Read volatile a t # is', θ, sb⇩h, m,𝒟⇩h, 𝒪⇩h, ℛ⇩h,𝒮⇩h) →⇩s⇩b⇩h
(is', θ(t ↦ v), sb⇩h@ [Read⇩s⇩b volatile a t v], m, 𝒟⇩h, 𝒪⇩h, ℛ⇩h, 𝒮⇩h)".
from sbh_computation.Memop [OF i_bound' ts⇩h_i this]
have step: "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h (?ts⇩h', m, 𝒮⇩h)".
from sb have sb: "sb = filter is_Write⇩s⇩b (sb⇩h @ [Read⇩s⇩b volatile a t v])"
by simp
show ?thesis
proof (cases "filter is_Write⇩s⇩b sb⇩h = []")
case False
have "ts [i := (p,is',θ(t ↦ v),sb,𝒟,𝒪,ℛ)] ∼⇩h ?ts⇩h'"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb sb_empty False
apply (auto simp add: Let_def nth_list_update)
done
with step show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
next
case True
with sb_empty have empty: "sb⇩h=[]" by simp
from i_bound' have "?ts⇩h'!i = ?ts⇩h_i'"
by auto
from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Read⇩s⇩b, of m 𝒮⇩h] i_bound'
have "(?ts⇩h', m, 𝒮⇩h)
⇒⇩s⇩b⇩h (ts⇩h[i := (p, is', θ(t ↦ v), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m, 𝒮⇩h)"
by (simp add: empty list_update_overwrite)
with step have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧*
(ts⇩h[i := (p, is', θ(t ↦ v), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m,𝒮⇩h)"
by force
moreover
have "ts [i := (p,is',θ(t ↦ v),sb,𝒟,𝒪,ℛ)] ∼⇩h ts⇩h[i := (p, is', θ(t ↦ v), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb empty
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
qed
next
case (SBReadUnbuffered a volatile t)
then obtain
"is": "is = Read volatile a t#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ(t↦m a)" and
sb': "sb' = sb" and
buf: "buffered_val sb a = None"
by auto
from sim_loc [rule_format, OF i_bound] ts_i "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Read volatile a t#is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h" and
sb_empty: "filter is_Write⇩s⇩b sb⇩h = [] ⟶ sb⇩h=[]"
by (auto simp add: Let_def)
from buf
have buf': "buffered_val sb⇩h a = None"
by (simp add: bufferd_val_filter_is_Write⇩s⇩b_eq sb)
let ?ts⇩h_i' = "(p, is', θ(t ↦ m a), sb⇩h @ [Read⇩s⇩b volatile a t (m a)], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)"
let ?ts⇩h' = "ts⇩h[i := ?ts⇩h_i']"
from sbh_memop_step.SBHReadUnbuffered [OF buf']
have "(Read volatile a t # is',θ, sb⇩h, m, 𝒟⇩h, 𝒪⇩h, ℛ⇩h,𝒮⇩h) →⇩s⇩b⇩h
(is', θ(t ↦ (m a)), sb⇩h@ [Read⇩s⇩b volatile a t (m a)], m,𝒟⇩h, 𝒪⇩h, ℛ⇩h,𝒮⇩h)".
from sbh_computation.Memop [OF i_bound' ts⇩h_i this]
have step: "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h
(?ts⇩h', m, 𝒮⇩h)".
moreover
from sb have sb: "sb = filter is_Write⇩s⇩b (sb⇩h @ [Read⇩s⇩b volatile a t (m a)])"
by simp
show ?thesis
proof (cases "filter is_Write⇩s⇩b sb⇩h = []")
case False
have "ts [i := (p,is',θ (t↦m a),sb,𝒟,𝒪,ℛ)] ∼⇩h ?ts⇩h'"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb sb_empty False
apply (auto simp add: Let_def nth_list_update)
done
with step show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' ℛ' 𝒟' θ' sb')
next
case True
with sb_empty have empty: "sb⇩h=[]" by simp
from i_bound' have "?ts⇩h'!i = ?ts⇩h_i'"
by auto
from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Read⇩s⇩b, of m 𝒮⇩h] i_bound'
have "(?ts⇩h', m, 𝒮⇩h)
⇒⇩s⇩b⇩h (ts⇩h[i := (p, is', θ(t ↦ (m a)), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m, 𝒮⇩h)"
by (simp add: empty)
with step have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧*
(ts⇩h[i := (p, is', θ(t ↦ m a), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m, 𝒮⇩h)"
by force
moreover
have "ts [i := (p,is',θ(t ↦ m a),sb,𝒟,𝒪,ℛ)] ∼⇩h ts⇩h[i := (p, is', θ(t ↦ m a), [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb empty
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
qed
next
case (SBWriteNonVolatile a D f A L R W)
then obtain
"is": "is = Write False a (D, f) A L R W#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ" and
sb': "sb' = sb@[Write⇩s⇩b False a (D, f) (f θ) A L R W]"
by auto
from sim_loc [rule_format, OF i_bound] ts_i
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Write False a (D,f) A L R W#is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h"
by (auto simp add: Let_def "is")
from sbh_memop_step.SBHWriteNonVolatile
have "(Write False a (D, f) A L R W# is',θ, sb⇩h, m, 𝒟⇩h, 𝒪⇩h, ℛ⇩h,𝒮⇩h) →⇩s⇩b⇩h
(is', θ, sb⇩h @ [Write⇩s⇩b False a (D, f) (f θ) A L R W], m,𝒟⇩h, 𝒪⇩h, ℛ⇩h,𝒮⇩h)".
from sbh_computation.Memop [OF i_bound' ts⇩h_i this]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h
(ts⇩h[i := (p, is',θ, sb⇩h @ [Write⇩s⇩b False a (D, f) (f θ) A L R W], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)],
m, 𝒮⇩h)".
moreover
have "ts [i := (p,is',θ,sb @ [Write⇩s⇩b False a (D,f) (f θ) A L R W],𝒟,𝒪,ℛ)] ∼⇩h
ts⇩h[i := (p,is',θ, sb⇩h @ [Write⇩s⇩b False a (D,f) (f θ) A L R W],𝒟⇩h, 𝒪⇩h,ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: 𝒮' m' θ' 𝒪' ℛ' 𝒟' ts' sb')
next
case (SBWriteVolatile a D f A L R W)
then obtain
"is": "is = Write True a (D, f) A L R W#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ" and
sb': "sb' = sb@[Write⇩s⇩b True a (D, f) (f θ) A L R W]"
by auto
from sim_loc [rule_format, OF i_bound] ts_i "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Write True a (D,f) A L R W#is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h"
by (auto simp add: Let_def)
from sbh_computation.Memop [OF i_bound' ts⇩h_i SBHWriteVolatile
]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h
(ts⇩h[i := (p, is',θ, sb⇩h @ [Write⇩s⇩b True a (D, f) (f θ) A L R W], True, 𝒪⇩h,ℛ⇩h)],
m, 𝒮⇩h)".
moreover
have "ts [i := (p,is',θ,sb @ [Write⇩s⇩b True a (D,f) (f θ) A L R W],𝒟,𝒪,ℛ)] ∼⇩h
ts⇩h[i := (p,is', θ, sb⇩h @ [Write⇩s⇩b True a (D,f) (f θ) A L R W],True, 𝒪⇩h,ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' ℛ' 𝒮')
next
case SBFence
then obtain
"is": "is = Fence #is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ" and
sb: "sb = []" and
sb': "sb' = []"
by auto
from sim_loc [rule_format, OF i_bound] ts_i sb "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Fence # is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "[] = filter is_Write⇩s⇩b sb⇩h"
by (auto simp add: Let_def)
from filter_is_Write⇩s⇩b_empty [OF sb [symmetric]]
have "∀r ∈ set sb⇩h. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r".
from flush_reads_program [OF this] obtain 𝒪⇩h' 𝒮⇩h' ℛ⇩h'
where flsh: "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m, [],𝒪⇩h',ℛ⇩h',𝒮⇩h')" by blast
let ?ts⇩h' = "ts⇩h[i := (p,Fence # is', θ, [], 𝒟⇩h, 𝒪⇩h',ℛ⇩h')]"
from sbh_computation.store_buffer_steps [OF flsh i_bound' ts⇩h_i]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (?ts⇩h', m, 𝒮⇩h')".
also
from i_bound' have i_bound'': "i < length ?ts⇩h'"
by auto
from i_bound' have ts⇩h'_i: "?ts⇩h'!i = (p,Fence#is',θ,[],𝒟⇩h,𝒪⇩h',ℛ⇩h')"
by simp
from sbh_computation.Memop [OF i_bound'' ts⇩h'_i SBHFence] i_bound'
have "(?ts⇩h', m, 𝒮⇩h') ⇒⇩s⇩b⇩h (ts⇩h[i := (p, is',θ, [], False, 𝒪⇩h',Map.empty)], m,𝒮⇩h')"
by (simp)
finally
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h[i := (p, is', θ, [],False, 𝒪⇩h',Map.empty)],m, 𝒮⇩h')".
moreover
have "ts [i := (p,is',θ,[],𝒟,𝒪,ℛ)] ∼⇩h ts⇩h[i := (p,is', θ, [],False, 𝒪⇩h',Map.empty)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')
next
case (SBRMWReadOnly cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ(t ↦ m a)" and
sb: "sb=[]" and
sb': "sb' = []" and
cond: "¬ cond (θ(t ↦ m a))"
by auto
from sim_loc [rule_format, OF i_bound] ts_i sb "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,RMW a t (D, f) cond ret A L R W# is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "[] = filter is_Write⇩s⇩b sb⇩h"
by (auto simp add: Let_def)
from filter_is_Write⇩s⇩b_empty [OF sb [symmetric]]
have "∀r ∈ set sb⇩h. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r".
from flush_reads_program [OF this] obtain 𝒪⇩h' 𝒮⇩h' ℛ⇩h'
where flsh: "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m, [],𝒪⇩h',ℛ⇩h',𝒮⇩h')" by blast
let ?ts⇩h' = "ts⇩h[i := (p,RMW a t (D, f) cond ret A L R W# is',θ, [], 𝒟⇩h, 𝒪⇩h',ℛ⇩h')]"
from sbh_computation.store_buffer_steps [OF flsh i_bound' ts⇩h_i]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (?ts⇩h', m, 𝒮⇩h')".
also
from i_bound' have i_bound'': "i < length ?ts⇩h'"
by auto
from i_bound' have ts⇩h'_i: "?ts⇩h'!i = (p,RMW a t (D, f) cond ret A L R W#is',θ,[],𝒟⇩h,𝒪⇩h',ℛ⇩h')"
by simp
note step= SBHRMWReadOnly [where cond=cond and θ=θ and m=m, OF cond ]
from sbh_computation.Memop [OF i_bound'' ts⇩h'_i step ] i_bound'
have "(?ts⇩h', m, 𝒮⇩h') ⇒⇩s⇩b⇩h (ts⇩h[i := (p, is',θ(t↦m a), [], False, 𝒪⇩h',Map.empty)],m, 𝒮⇩h')"
by (simp)
finally
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h[i := (p, is',θ(t↦m a), [], False, 𝒪⇩h',Map.empty)],m, 𝒮⇩h')".
moreover
have "ts [i := (p,is',θ(t↦m a),[],𝒟,𝒪,ℛ)] ∼⇩h ts⇩h[i := (p,is', θ(t↦m a), [], False, 𝒪⇩h',Map.empty)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')
next
case (SBRMWWrite cond t a D f ret A L R W)
then obtain
"is": "is = RMW a t (D, f) cond ret A L R W#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m(a := f (θ(t ↦ (m a))))" and
θ': "θ'=θ(t ↦ ret (m a) (f (θ(t ↦ (m a)))))" and
sb: "sb=[]" and
sb': "sb' = []" and
cond: "cond (θ(t ↦ m a))"
by auto
from sim_loc [rule_format, OF i_bound] ts_i sb "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h acq⇩h where
ts⇩h_i: "ts⇩h!i = (p,RMW a t (D, f) cond ret A L R W# is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "[] = filter is_Write⇩s⇩b sb⇩h"
by (auto simp add: Let_def)
from filter_is_Write⇩s⇩b_empty [OF sb [symmetric]]
have "∀r ∈ set sb⇩h. is_Read⇩s⇩b r ∨ is_Prog⇩s⇩b r ∨ is_Ghost⇩s⇩b r".
from flush_reads_program [OF this] obtain 𝒪⇩h' 𝒮⇩h' ℛ⇩h'
where flsh: "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m, [],𝒪⇩h',ℛ⇩h',𝒮⇩h')" by blast
let ?ts⇩h' = "ts⇩h[i := (p,RMW a t (D, f) cond ret A L R W# is',θ, [], 𝒟⇩h, 𝒪⇩h',ℛ⇩h')]"
from sbh_computation.store_buffer_steps [OF flsh i_bound' ts⇩h_i]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (?ts⇩h', m, 𝒮⇩h')".
also
from i_bound' have i_bound'': "i < length ?ts⇩h'"
by auto
from i_bound' have ts⇩h'_i: "?ts⇩h'!i = (p,RMW a t (D, f) cond ret A L R W#is',θ,[],𝒟⇩h,𝒪⇩h',ℛ⇩h')"
by simp
note step= SBHRMWWrite [where cond=cond and θ=θ and m=m, OF cond]
from sbh_computation.Memop [OF i_bound'' ts⇩h'_i step ] i_bound'
have "(?ts⇩h', m, 𝒮⇩h') ⇒⇩s⇩b⇩h (ts⇩h[i := (p, is',
θ(t ↦ ret (m a) (f (θ(t ↦ (m a))))), [], False, 𝒪⇩h' ∪ A - R,Map.empty)],
m(a := f (θ(t ↦ (m a)))),𝒮⇩h' ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (simp)
finally
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h[i := (p, is',
θ(t ↦ ret (m a) (f (θ(t ↦ (m a))))), [], False, 𝒪⇩h' ∪ A - R,Map.empty)],
m(a := f (θ(t ↦ (m a)))),𝒮⇩h' ⊕⇘W⇙ R ⊖⇘A⇙ L)".
moreover
have "ts [i := (p,is',θ(t ↦ ret (m a) (f (θ(t ↦ (m a))))),[],𝒟,𝒪,ℛ)] ∼⇩h
ts⇩h[i := (p,is',θ(t ↦ ret (m a) (f (θ(t ↦ (m a))))), [],False, 𝒪⇩h' ∪ A - R,Map.empty)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: ts' 𝒪' θ' m' sb' 𝒟' 𝒮' ℛ')
next
case (SBGhost A L R W)
then obtain
"is": "is = Ghost A L R W#is'" and
𝒪': "𝒪'=𝒪" and
ℛ': "ℛ'=ℛ" and
𝒮': "𝒮'=𝒮" and
𝒟': "𝒟'=𝒟" and
m': "m'=m" and
θ': "θ'=θ" and
sb': "sb' = sb"
by auto
from sim_loc [rule_format, OF i_bound] ts_i "is"
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h where
ts⇩h_i: "ts⇩h!i = (p,Ghost A L R W# is',θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h" and
sb_empty: "filter is_Write⇩s⇩b sb⇩h = [] ⟶ sb⇩h=[]"
by (auto simp add: Let_def)
let ?ts⇩h_i' = "(p, is', θ, sb⇩h@[Ghost⇩s⇩b A L R W],𝒟⇩h, 𝒪⇩h,ℛ⇩h)"
let ?ts⇩h' = "ts⇩h[i := ?ts⇩h_i']"
note step= SBHGhost
from sbh_computation.Memop [OF i_bound' ts⇩h_i step ] i_bound'
have step: "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h (?ts⇩h',m, 𝒮⇩h)"
by (simp)
from sb have sb: "sb = filter is_Write⇩s⇩b (sb⇩h @ [Ghost⇩s⇩b A L R W])"
by simp
show ?thesis
proof (cases "filter is_Write⇩s⇩b sb⇩h = []")
case False
have "ts [i := (p,is',θ,sb,𝒟,𝒪,ℛ)] ∼⇩h ?ts⇩h'"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb sb_empty False
apply (auto simp add: Let_def nth_list_update)
done
with step show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' 𝒟' θ' sb' ℛ')
next
case True
with sb_empty have empty: "sb⇩h=[]" by simp
from i_bound' have "?ts⇩h'!i = ?ts⇩h_i'"
by auto
from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Ghost, of m 𝒮⇩h] i_bound'
have "(?ts⇩h', m, 𝒮⇩h)
⇒⇩s⇩b⇩h (ts⇩h[i := (p, is', θ, [], 𝒟⇩h, 𝒪⇩h ∪ A - R,augment_rels (dom 𝒮⇩h) R ℛ⇩h)], m, 𝒮⇩h ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by (simp add: empty)
with step have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧*
(ts⇩h[i := (p, is', θ, [], 𝒟⇩h, 𝒪⇩h ∪ A - R,augment_rels (dom 𝒮⇩h) R ℛ⇩h)], m, 𝒮⇩h ⊕⇘W⇙ R ⊖⇘A⇙ L)"
by force
moreover
have "ts [i := (p,is',θ,sb,𝒟,𝒪,ℛ)] ∼⇩h
ts⇩h[i := (p, is', θ, [], 𝒟⇩h, 𝒪⇩h ∪ A - R,augment_rels (dom 𝒮⇩h) R ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb empty
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts' 𝒪' θ' 𝒟' sb' ℛ')
qed
qed
next
case (Program i _ p "is" θ sb 𝒟 𝒪 ℛ p' "is'")
then obtain
ts': "ts' = ts[i := (p', is@is',θ, sb, 𝒟, 𝒪,ℛ)]" and
i_bound: "i < length ts" and
ts_i: "ts ! i = (p, is, θ,sb,𝒟, 𝒪,ℛ)" and
prog_step: "θ⊢ p →⇩p (p', is')" and
𝒮': "𝒮'=𝒮" and
m': "m'=m"
by auto
from sim obtain
lts_eq: "length ts = length ts⇩h" and
sim_loc: "∀i < length ts. (∃𝒪' 𝒟' ℛ'.
let (p,is,θ, sb, 𝒟, 𝒪,ℛ) = ts⇩h!i in ts!i=(p,is, θ, filter is_Write⇩s⇩b sb,𝒟',𝒪',ℛ') ∧
(filter is_Write⇩s⇩b sb = [] ⟶ sb = []))"
by cases auto
from sim_loc [rule_format, OF i_bound] ts_i
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h acq⇩h where
ts⇩h_i: "ts⇩h!i = (p,is,θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h" and
sb_empty: "filter is_Write⇩s⇩b sb⇩h = [] ⟶ sb⇩h=[]"
by (auto simp add: Let_def)
from lts_eq i_bound have i_bound': "i < length ts⇩h"
by simp
let ?ts⇩h_i' = "(p', is @ is',θ, sb⇩h @ [Prog⇩s⇩b p p' is'], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)"
let ?ts⇩h' = "ts⇩h[i := ?ts⇩h_i']"
from sbh_computation.Program [OF i_bound' ts⇩h_i prog_step]
have step: "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h (?ts⇩h',m, 𝒮⇩h)".
show ?thesis
proof (cases "filter is_Write⇩s⇩b sb⇩h = []")
case False
have "ts[i := (p', is@is', θ, sb,𝒟, 𝒪,ℛ)] ∼⇩h ?ts⇩h'"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb False sb_empty
apply (auto simp add: Let_def nth_list_update)
done
with step show ?thesis
by (auto simp add: ts' 𝒮' m')
next
case True
with sb_empty have empty: "sb⇩h=[]" by simp
from i_bound' have "?ts⇩h'!i = ?ts⇩h_i'"
by auto
from sbh_computation.StoreBuffer [OF _ this, simplified empty, simplified, OF _ flush_step.Prog⇩s⇩b, of m 𝒮⇩h] i_bound'
have "(?ts⇩h', m, 𝒮⇩h)
⇒⇩s⇩b⇩h (ts⇩h[i := (p', is@is', θ, [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m, 𝒮⇩h)"
by (simp add: empty)
with step have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧*
(ts⇩h[i := (p', is@is', θ, [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)], m, 𝒮⇩h) "
by force
moreover
have "ts[i := (p', is@is', θ, sb,𝒟, 𝒪,ℛ)] ∼⇩h ts⇩h[i := (p', is@is', θ, [], 𝒟⇩h, 𝒪⇩h,ℛ⇩h)]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb empty
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp del: fun_upd_apply simp add: 𝒮' m' ts')
qed
next
case (StoreBuffer i _ p "is" θ sb 𝒟 𝒪 ℛ _ _ _ sb' 𝒪' ℛ')
then obtain
ts': "ts' = ts[i := (p, is,θ, sb', 𝒟, 𝒪',ℛ')]" and
i_bound: "i < length ts" and
ts_i: "ts ! i = (p, is,θ,sb, 𝒟, 𝒪,ℛ)" and
sb_step: "(m,sb,𝒪,ℛ,𝒮) →⇩w (m', sb',𝒪',ℛ',𝒮')"
by auto
from sim obtain
lts_eq: "length ts = length ts⇩h" and
sim_loc: "∀i < length ts. (∃𝒪' 𝒟' ℛ'.
let (p,is, θ, sb,𝒟, 𝒪,ℛ) = ts⇩h!i in ts!i=(p,is, θ, filter is_Write⇩s⇩b sb,𝒟',𝒪',ℛ') ∧
(filter is_Write⇩s⇩b sb = [] ⟶ sb=[]))"
by cases auto
from sim_loc [rule_format, OF i_bound] ts_i
obtain sb⇩h 𝒪⇩h ℛ⇩h 𝒟⇩h acq⇩h where
ts⇩h_i: "ts⇩h!i = (p,is,θ,sb⇩h,𝒟⇩h,𝒪⇩h,ℛ⇩h)" and
sb: "sb = filter is_Write⇩s⇩b sb⇩h" and
sb_empty: "filter is_Write⇩s⇩b sb⇩h = [] ⟶ sb⇩h=[]"
by (auto simp add: Let_def)
from lts_eq i_bound have i_bound': "i < length ts⇩h"
by simp
from flush_simulates_filter_writes [OF sb_step sb, of 𝒪⇩h ℛ⇩h 𝒮⇩h]
obtain sb⇩h' 𝒪⇩h' ℛ⇩h' 𝒮⇩h'
where flush': "(m, sb⇩h,𝒪⇩h,ℛ⇩h,𝒮⇩h) →⇩f⇧* (m', sb⇩h',𝒪⇩h',ℛ⇩h',𝒮⇩h')" and
sb': "sb' = filter is_Write⇩s⇩b sb⇩h'" and
sb'_empty: "filter is_Write⇩s⇩b sb⇩h' = [] ⟶ sb⇩h'=[]"
by auto
from sb_step obtain volatile a sop v A L R W where "sb=Write⇩s⇩b volatile a sop v A L R W#sb'"
by cases force
from sbh_computation.store_buffer_steps [OF flush' i_bound' ts⇩h_i]
have "(ts⇩h, m, 𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h[i := (p, is, θ, sb⇩h',𝒟⇩h, 𝒪⇩h',ℛ⇩h')], m', 𝒮⇩h')".
moreover
have "ts[i := (p, is, θ, sb',𝒟, 𝒪',ℛ')] ∼⇩h
ts⇩h[i := (p, is, θ, sb⇩h',𝒟⇩h, 𝒪⇩h',ℛ⇩h')]"
apply (rule sim_history_config.intros)
using lts_eq
apply simp
using sim_loc i_bound i_bound' sb sb' sb'_empty
apply (auto simp add: Let_def nth_list_update)
done
ultimately show ?thesis
by (auto simp add: ts' )
qed
qed
theorem (in valid_program) concurrent_history_steps_simulates_store_buffer_steps:
assumes step_sb: "(ts,m,𝒮) ⇒⇩s⇩b⇧* (ts',m',𝒮')"
shows "⋀ts⇩h 𝒮⇩h. ts ∼⇩h ts⇩h ⟹ ∃ts⇩h' 𝒮⇩h'. (ts⇩h,m,𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m',𝒮⇩h') ∧ ts' ∼⇩h ts⇩h'"
using step_sb
proof (induct rule: converse_rtranclp_induct_sbh_steps)
case refl thus ?case by auto
next
case (step ts m 𝒮 ts'' m'' 𝒮'' )
have first: "(ts,m,𝒮) ⇒⇩s⇩b (ts'',m'',𝒮'')" by fact
have sim: "ts ∼⇩h ts⇩h" by fact
from concurrent_history_steps_simulates_store_buffer_step [OF first sim, of 𝒮⇩h]
obtain ts⇩h'' 𝒮⇩h'' where
exec: "(ts⇩h,m,𝒮⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩h'',m'',𝒮⇩h'')" and sim: "ts'' ∼⇩h ts⇩h''"
by auto
from step.hyps (3) [OF sim, of 𝒮⇩h'']
obtain ts⇩h' 𝒮⇩h' where exec_rest: "(ts⇩h'',m'',𝒮⇩h'') ⇒⇩s⇩b⇩h⇧* (ts⇩h',m',𝒮⇩h')" and sim': "ts' ∼⇩h ts⇩h'"
by auto
note exec also note exec_rest
finally show ?case
using sim' by blast
qed
theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_execution:
assumes exec_sb: "(ts⇩s⇩b,m⇩s⇩b,x) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m⇩s⇩b',x')"
assumes init: "initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b"
assumes valid: "valid ts⇩s⇩b"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "∃ts⇩h' 𝒮⇩h' ts' m' 𝒮'.
(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m⇩s⇩b',𝒮⇩h') ∧
ts⇩s⇩b' ∼⇩h ts⇩h' ∧
(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧
(ts⇩h',m⇩s⇩b',𝒮⇩h') ∼ (ts',m',𝒮')"
proof -
from init interpret ini: initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b .
from concurrent_history_steps_simulates_store_buffer_steps [OF exec_sb ini.history_refl, of 𝒮⇩s⇩b]
obtain ts⇩h' 𝒮⇩h' where
sbh: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m⇩s⇩b',𝒮⇩h')" and
sim_sbh: "ts⇩s⇩b' ∼⇩h ts⇩h'"
by auto
from concurrent_direct_execution_simulates_store_buffer_history_execution [OF sbh init valid sim safe]
obtain ts' m' 𝒮' where
d: "(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')" and
d_sim: "(ts⇩h',m⇩s⇩b',𝒮⇩h') ∼ (ts',m',𝒮')"
by auto
with sbh sim_sbh show ?thesis by blast
qed
inductive sim_direct_config::
"('p,'p store_buffer,'dirty,'owns,'rels) thread_config list ⇒ ('p,unit,bool,'owns','rels') thread_config list ⇒ bool"
("_ ∼⇩d _ " [60,60] 100)
where
"⟦length ts = length ts⇩d;
∀i < length ts.
(∃𝒪' 𝒟' ℛ'.
let (p,is, θ,sb,𝒟, 𝒪,ℛ) = ts⇩d!i in
ts!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))
⟧
⟹
ts ∼⇩d ts⇩d"
lemma empty_sb_sims:
assumes empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩s⇩b ⟶ ts⇩s⇩b!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
assumes sim_h: "ts⇩s⇩b ∼⇩h ts⇩h"
assumes sim_d: "(ts⇩h,m⇩h,𝒮⇩h) ∼ (ts,m,𝒮)"
shows "ts⇩s⇩b ∼⇩d ts ∧ m⇩h=m ∧ length ts⇩s⇩b = length ts"
proof-
from sim_h empty
have empty':
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩h ⟶ ts⇩h!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
apply (cases)
apply clarsimp
subgoal for i
apply (drule_tac x=i in spec)
apply (auto simp add: Let_def)
done
done
from sim_h sim_config_emptyE [OF empty' sim_d]
show ?thesis
apply cases
apply clarsimp
apply (rule sim_direct_config.intros)
apply clarsimp
apply clarsimp
using empty'
subgoal for i
apply (drule_tac x=i in spec)
apply (drule_tac x=i in spec)
apply (drule_tac x=i in spec)
apply (auto simp add: Let_def)
done
done
qed
lemma empty_d_sims:
assumes sim: "ts⇩s⇩b ∼⇩d ts"
shows "∃ts⇩h. ts⇩s⇩b ∼⇩h ts⇩h ∧ (ts⇩h,m,𝒮) ∼ (ts,m,𝒮)"
proof -
from sim obtain
leq: "length ts⇩s⇩b = length ts" and
sim: "∀i < length ts⇩s⇩b.
(∃𝒪' 𝒟' ℛ'.
let (p,is, θ,sb,𝒟, 𝒪,ℛ) = ts!i in
ts⇩s⇩b!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))"
by cases auto
define ts⇩h where "ts⇩h ≡ map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ). (p,is, θ,[]::'a memref list,𝒟, 𝒪,ℛ)) ts"
have "ts⇩s⇩b ∼⇩h ts⇩h"
apply (rule sim_history_config.intros)
using leq sim
apply (auto simp add: ts⇩h_def Let_def leq)
done
moreover
have empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩h ⟶ ts⇩h!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
apply (clarsimp simp add: ts⇩h_def Let_def)
subgoal for i
apply (case_tac "ts!i")
apply auto
done
done
have "(ts⇩h,m,𝒮) ∼ (ts,m,𝒮)"
apply (rule sim_config_emptyI [OF empty])
apply (clarsimp simp add: ts⇩h_def)
apply (clarsimp simp add: ts⇩h_def Let_def)
subgoal for i
apply (case_tac "ts!i")
apply auto
done
done
ultimately show ?thesis by blast
qed
theorem (in xvalid_program_progress) concurrent_direct_execution_simulates_store_buffer_execution_empty:
assumes exec_sb: "(ts⇩s⇩b,m⇩s⇩b,x) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m⇩s⇩b',x')"
assumes init: "initial⇩s⇩b ts⇩s⇩b 𝒮⇩s⇩b"
assumes valid: "valid ts⇩s⇩b"
assumes empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩s⇩b' ⟶ ts⇩s⇩b'!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "∃ts' 𝒮'.
(ts,m,𝒮) ⇒⇩d⇧* (ts',m⇩s⇩b',𝒮') ∧ ts⇩s⇩b' ∼⇩d ts'"
proof -
from concurrent_direct_execution_simulates_store_buffer_execution [OF exec_sb init valid sim safe]
obtain ts⇩h' 𝒮⇩h' ts' m' 𝒮' where
"(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m⇩s⇩b',𝒮⇩h')" and
sim_h: "ts⇩s⇩b' ∼⇩h ts⇩h'" and
exec: "(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')" and
sim: "(ts⇩h',m⇩s⇩b',𝒮⇩h') ∼ (ts',m',𝒮')"
by auto
from empty_sb_sims [OF empty sim_h sim]
obtain "ts⇩s⇩b' ∼⇩d ts'" "m⇩s⇩b' = m'" "length ts⇩s⇩b' = length ts'"
by auto
thus ?thesis
using exec
by blast
qed
locale initial⇩d = simple_ownership_distinct + read_only_unowned + unowned_shared +
fixes valid
assumes empty_is: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ is=[]"
assumes empty_rels: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ ℛ=Map.empty"
assumes valid_init: "valid (map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ). (p,is, θ,[],𝒟, 𝒪,ℛ)) ts)"
locale empty_store_buffers =
fixes ts::"('p,'p store_buffer,bool,owns,rels) thread_config list"
assumes empty_sb: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ sb=[]"
lemma initial_d_sb:
assumes init: "initial⇩d ts 𝒮 valid"
shows "initial⇩s⇩b (map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ). (p,is, θ,[],𝒟, 𝒪,ℛ)) ts) 𝒮"
(is "initial⇩s⇩b ?map 𝒮")
proof -
from init interpret ini: initial⇩d ts 𝒮 .
show ?thesis
proof (intro_locales)
show "simple_ownership_distinct ?map"
apply (clarsimp simp add: simple_ownership_distinct_def)
subgoal for i j
apply (case_tac "ts!i")
apply (case_tac "ts!j")
apply (cut_tac i=i and j=j in ini.simple_ownership_distinct)
apply clarsimp
apply clarsimp
apply clarsimp
apply assumption
apply assumption
apply auto
done
done
next
show "read_only_unowned 𝒮 ?map"
apply (clarsimp simp add: read_only_unowned_def)
subgoal for i
apply (case_tac "ts!i")
apply (cut_tac i=i in ini.read_only_unowned)
apply clarsimp
apply assumption
apply auto
done
done
next
show "unowned_shared 𝒮 ?map"
apply (clarsimp simp add: unowned_shared_def')
apply (rule ini.unowned_shared')
apply clarsimp
subgoal for a i
apply (case_tac "ts!i")
apply auto
done
done
next
show "initial⇩s⇩b_axioms ?map"
apply (unfold_locales)
subgoal for i
apply (case_tac "ts!i")
apply simp
done
subgoal for i
apply (case_tac "ts!i")
apply clarsimp
apply (rule_tac i=i in ini.empty_is)
apply clarsimp
apply fastforce
done
subgoal for i
apply (case_tac "ts!i")
apply clarsimp
apply (rule_tac i=i in ini.empty_rels)
apply clarsimp
apply fastforce
done
done
qed
qed
theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent:
assumes exec_sb: "(ts⇩s⇩b,m,x) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m',x')"
assumes empty': "empty_store_buffers ts⇩s⇩b'"
assumes sim: "ts⇩s⇩b ∼⇩d ts"
assumes init: "initial⇩d ts 𝒮 valid"
assumes safe: "safe_reach_direct safe_free_flowing (ts,m,𝒮)"
shows "∃ts' 𝒮'.
(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧ ts⇩s⇩b' ∼⇩d ts'"
proof -
from empty'
have empty':
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩s⇩b' ⟶ ts⇩s⇩b'!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
by (auto simp add: empty_store_buffers_def)
define ts⇩h where "ts⇩h ≡ map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ). (p,is, θ,[]::'a memref list,𝒟, 𝒪,ℛ)) ts"
from initial_d_sb [OF init]
have init_h:"initial⇩s⇩b ts⇩h 𝒮"
by (simp add: ts⇩h_def)
from initial⇩d.valid_init [OF init]
have valid_h: "valid ts⇩h"
by (simp add: ts⇩h_def)
from sim obtain
leq: "length ts⇩s⇩b = length ts" and
sim: "∀i < length ts⇩s⇩b.
(∃𝒪' 𝒟' ℛ'.
let (p,is, θ,sb,𝒟, 𝒪,ℛ) = ts!i in
ts⇩s⇩b!i=(p,is, θ, [] ,𝒟',𝒪',ℛ'))"
by cases auto
have sim_h: "ts⇩s⇩b ∼⇩h ts⇩h"
apply (rule sim_history_config.intros)
using leq sim
apply (auto simp add: ts⇩h_def Let_def leq)
done
from concurrent_history_steps_simulates_store_buffer_steps [OF exec_sb sim_h, of 𝒮]
obtain ts⇩h' 𝒮⇩h' where steps_h: "(ts⇩h,m,𝒮) ⇒⇩s⇩b⇩h⇧* (ts⇩h',m',𝒮⇩h')" and
sim_h': "ts⇩s⇩b' ∼⇩h ts⇩h'"
by auto
moreover
have empty:
"∀i p is xs sb 𝒟 𝒪 ℛ. i < length ts⇩h ⟶ ts⇩h!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟶ sb=[]"
apply (clarsimp simp add: ts⇩h_def Let_def)
subgoal for i
apply (case_tac "ts!i")
apply auto
done
done
have sim': "(ts⇩h,m,𝒮) ∼ (ts,m,𝒮)"
apply (rule sim_config_emptyI [OF empty])
apply (clarsimp simp add: ts⇩h_def)
apply (clarsimp simp add: ts⇩h_def Let_def)
subgoal for i
apply (case_tac "ts!i")
apply auto
done
done
from concurrent_direct_execution_simulates_store_buffer_history_execution [OF steps_h init_h valid_h sim' safe]
obtain ts' m'' 𝒮'' where steps: "(ts, m, 𝒮) ⇒⇩d⇧* (ts', m'', 𝒮'')"
and sim': "(ts⇩h', m', 𝒮⇩h') ∼ (ts', m'', 𝒮'')"
by blast
from empty_sb_sims [OF empty' sim_h' sim'] steps
show ?thesis
by auto
qed
locale initial⇩v = simple_ownership_distinct + read_only_unowned + unowned_shared +
fixes valid
assumes empty_is: "⟦i < length ts; ts!i=(p,is,xs,sb,𝒟,𝒪,ℛ)⟧ ⟹ is=[]"
assumes valid_init: "valid (map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ). (p,is, θ,[],𝒟, 𝒪,Map.empty)) ts)"
theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent':
assumes exec_sb: "(ts⇩s⇩b,m,x) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m',x')"
assumes empty': "empty_store_buffers ts⇩s⇩b'"
assumes sim: "ts⇩s⇩b ∼⇩d ts"
assumes init: "initial⇩v ts 𝒮 valid"
assumes safe: "safe_reach_virtual safe_free_flowing (ts,m,𝒮)"
shows "∃ts' 𝒮'.
(ts,m,𝒮) ⇒⇩v⇧* (ts',m',𝒮') ∧ ts⇩s⇩b' ∼⇩d ts'"
proof -
define ts⇩d where "ts⇩d == (map (λ(p,is, θ,sb,𝒟, 𝒪,ℛ'). (p,is, θ,sb,𝒟, 𝒪,Map.empty::rels)) ts)"
have rem_ts: "remove_rels ts⇩d = ts"
apply (rule nth_equalityI)
apply (simp add: ts⇩d_def remove_rels_def)
apply (clarsimp simp add: ts⇩d_def remove_rels_def)
subgoal for i
apply (case_tac "ts!i")
apply clarsimp
done
done
from sim
have sim': "ts⇩s⇩b ∼⇩d ts⇩d"
apply cases
apply (rule sim_direct_config.intros)
apply (auto simp add: ts⇩d_def)
done
have init': "initial⇩d ts⇩d 𝒮 valid"
proof (intro_locales)
from init have "simple_ownership_distinct ts"
by (simp add: initial⇩v_def)
then
show "simple_ownership_distinct ts⇩d"
apply (clarsimp simp add: ts⇩d_def simple_ownership_distinct_def)
subgoal for i j
apply (case_tac "ts!i")
apply (case_tac "ts!j")
apply force
done
done
next
from init have "read_only_unowned 𝒮 ts"
by (simp add: initial⇩v_def)
then show "read_only_unowned 𝒮 ts⇩d"
apply (clarsimp simp add: ts⇩d_def read_only_unowned_def)
subgoal for i
apply (case_tac "ts!i")
apply force
done
done
next
from init have "unowned_shared 𝒮 ts"
by (simp add: initial⇩v_def)
then
show "unowned_shared 𝒮 ts⇩d"
apply (clarsimp simp add: ts⇩d_def unowned_shared_def)
apply force
done
next
have eq: "((λ(p, is, θ, sb, 𝒟, 𝒪, ℛ). (p, is, θ, [], 𝒟, 𝒪, ℛ)) ∘
(λ(p, is, θ, sb, 𝒟, 𝒪, ℛ'). (p, is, θ, (), 𝒟, 𝒪, Map.empty)))
= (λ(p, is, θ, sb, 𝒟, 𝒪, ℛ'). (p, is, θ, [], 𝒟, 𝒪, Map.empty))"
apply (rule ext)
subgoal for x
apply (case_tac x)
apply auto
done
done
from init have "initial⇩v_axioms ts valid"
by (simp add: initial⇩v_def)
then
show "initial⇩d_axioms ts⇩d valid"
apply (clarsimp simp add: ts⇩d_def initial⇩v_axioms_def initial⇩d_axioms_def eq)
apply (rule conjI)
apply clarsimp
subgoal for i
apply (case_tac "ts!i")
apply force
done
apply clarsimp
subgoal for i
apply (case_tac "ts!i")
apply force
done
done
qed
{
fix ts⇩d' m' 𝒮'
assume exec: "(ts⇩d, m, 𝒮) ⇒⇩d⇧* (ts⇩d', m', 𝒮')"
have "safe_free_flowing (ts⇩d', m', 𝒮')"
proof -
from virtual_simulates_direct_steps [OF exec]
have exec_v: "(ts, m, 𝒮) ⇒⇩v⇧* (remove_rels ts⇩d', m', 𝒮')"
by (simp add: rem_ts)
have eq: "map (owned ∘
(λ(p, is, θ, sb, 𝒟, 𝒪, ℛ). (p, is, θ, (), 𝒟, 𝒪, ())))
ts⇩d' = map owned ts⇩d'"
by auto
from exec_v safe
have "safe_free_flowing (remove_rels ts⇩d', m', 𝒮')"
by (auto simp add: safe_reach_def)
then show ?thesis
by (auto simp add: safe_free_flowing_def remove_rels_def owned_def eq)
qed
}
hence safe': "safe_reach_direct safe_free_flowing (ts⇩d, m, 𝒮)"
by (simp add: safe_reach_def)
from store_buffer_execution_result_sequential_consistent [OF exec_sb empty' sim' init' safe']
obtain ts⇩d' 𝒮' where
exec_d: "(ts⇩d, m, 𝒮) ⇒⇩d⇧* (ts⇩d', m', 𝒮')" and sim_d: "ts⇩s⇩b' ∼⇩d ts⇩d'"
by blast
from virtual_simulates_direct_steps [OF exec_d]
have "(ts, m, 𝒮) ⇒⇩v⇧* (remove_rels ts⇩d', m', 𝒮')"
by (simp add: rem_ts)
moreover
from sim_d
have "ts⇩s⇩b' ∼⇩d remove_rels ts⇩d'"
apply (cases)
apply (rule sim_direct_config.intros)
apply (auto simp add: remove_rels_def)
done
ultimately show ?thesis
by auto
qed
subsection ‹Plug Together the Two Simulations›
corollary (in xvalid_program) concurrent_direct_steps_simulates_store_buffer_step:
assumes step_sb: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b')"
assumes sim_h: "ts⇩s⇩b ∼⇩h ts⇩s⇩b⇩h"
assumes sim: "(ts⇩s⇩b⇩h,m⇩s⇩b,𝒮⇩s⇩b⇩h) ∼ (ts,m,𝒮) "
assumes valid_own: "valid_ownership 𝒮⇩s⇩b⇩h ts⇩s⇩b⇩h"
assumes valid_sb_reads: "valid_reads m⇩s⇩b ts⇩s⇩b⇩h"
assumes valid_hist: "valid_history program_step ts⇩s⇩b⇩h"
assumes valid_sharing: "valid_sharing 𝒮⇩s⇩b⇩h ts⇩s⇩b⇩h"
assumes tmps_distinct: "tmps_distinct ts⇩s⇩b⇩h"
assumes valid_sops: "valid_sops ts⇩s⇩b⇩h"
assumes valid_dd: "valid_data_dependency ts⇩s⇩b⇩h"
assumes load_tmps_fresh: "load_tmps_fresh ts⇩s⇩b⇩h"
assumes enough_flushs: "enough_flushs ts⇩s⇩b⇩h"
assumes valid_program_history: "valid_program_history ts⇩s⇩b⇩h"
assumes valid: "valid ts⇩s⇩b⇩h"
assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
shows "∃ts⇩s⇩b⇩h' 𝒮⇩s⇩b⇩h'.
(ts⇩s⇩b⇩h,m⇩s⇩b,𝒮⇩s⇩b⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩s⇩b⇩h',m⇩s⇩b',𝒮⇩s⇩b⇩h') ∧ ts⇩s⇩b' ∼⇩h ts⇩s⇩b⇩h' ∧
valid_ownership 𝒮⇩s⇩b⇩h' ts⇩s⇩b⇩h' ∧ valid_reads m⇩s⇩b' ts⇩s⇩b⇩h' ∧
valid_history program_step ts⇩s⇩b⇩h' ∧
valid_sharing 𝒮⇩s⇩b⇩h' ts⇩s⇩b⇩h' ∧ tmps_distinct ts⇩s⇩b⇩h' ∧ valid_data_dependency ts⇩s⇩b⇩h' ∧
valid_sops ts⇩s⇩b⇩h' ∧ load_tmps_fresh ts⇩s⇩b⇩h' ∧ enough_flushs ts⇩s⇩b⇩h' ∧
valid_program_history ts⇩s⇩b⇩h' ∧ valid ts⇩s⇩b⇩h' ∧
(∃ts' 𝒮' m'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧
(ts⇩s⇩b⇩h',m⇩s⇩b',𝒮⇩s⇩b⇩h') ∼ (ts',m',𝒮'))"
proof -
from concurrent_history_steps_simulates_store_buffer_step [OF step_sb sim_h]
obtain ts⇩s⇩b⇩h' 𝒮⇩s⇩b⇩h' where
steps_h: "(ts⇩s⇩b⇩h,m⇩s⇩b,𝒮⇩s⇩b⇩h) ⇒⇩s⇩b⇩h⇧* (ts⇩s⇩b⇩h',m⇩s⇩b',𝒮⇩s⇩b⇩h')" and
sim_h': "ts⇩s⇩b' ∼⇩h ts⇩s⇩b⇩h'"
by blast
moreover
from concurrent_direct_steps_simulates_store_buffer_history_steps [OF steps_h
valid_own valid_sb_reads valid_hist valid_sharing tmps_distinct valid_sops valid_dd
load_tmps_fresh enough_flushs valid_program_history valid sim safe_reach]
obtain m' ts' 𝒮' where
"(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')" "(ts⇩s⇩b⇩h', m⇩s⇩b',𝒮⇩s⇩b⇩h') ∼ (ts', m', 𝒮')"
"valid_ownership 𝒮⇩s⇩b⇩h' ts⇩s⇩b⇩h'" "valid_reads m⇩s⇩b' ts⇩s⇩b⇩h'" "valid_history program_step ts⇩s⇩b⇩h'"
"valid_sharing 𝒮⇩s⇩b⇩h' ts⇩s⇩b⇩h'" "tmps_distinct ts⇩s⇩b⇩h'" "valid_data_dependency ts⇩s⇩b⇩h'"
"valid_sops ts⇩s⇩b⇩h'" "load_tmps_fresh ts⇩s⇩b⇩h'" "enough_flushs ts⇩s⇩b⇩h'"
"valid_program_history ts⇩s⇩b⇩h'" "valid ts⇩s⇩b⇩h'"
by blast
ultimately
show ?thesis
by blast
qed
lemma conj_commI: "P ∧ Q ⟹ Q ∧ P"
by simp
lemma def_to_eq: "P = Q ⟹ P ≡ Q"
by simp
context xvalid_program
begin
definition
"invariant ts 𝒮 m ≡
valid_ownership 𝒮 ts ∧ valid_reads m ts ∧ valid_history program_step ts ∧
valid_sharing 𝒮 ts ∧ tmps_distinct ts ∧ valid_data_dependency ts ∧
valid_sops ts ∧ load_tmps_fresh ts ∧ enough_flushs ts ∧ valid_program_history ts ∧
valid ts"
definition "ownership_inv ≡ valid_ownership"
definition "sharing_inv ≡ valid_sharing"
definition "temporaries_inv ts ≡ tmps_distinct ts ∧ load_tmps_fresh ts"
definition "history_inv ts m ≡ valid_history program_step ts ∧ valid_program_history ts ∧ valid_reads m ts"
definition "data_dependency_inv ts ≡ valid_data_dependency ts ∧ load_tmps_fresh ts ∧ valid_sops ts"
definition "barrier_inv ≡ enough_flushs"
lemma invariant_grouped_def: "invariant ts 𝒮 m ≡
ownership_inv 𝒮 ts ∧ sharing_inv 𝒮 ts ∧ temporaries_inv ts ∧ data_dependency_inv ts ∧ history_inv ts m ∧ barrier_inv ts ∧ valid ts"
apply (rule def_to_eq)
apply (auto simp add: ownership_inv_def sharing_inv_def barrier_inv_def temporaries_inv_def history_inv_def data_dependency_inv_def invariant_def)
done
theorem (in xvalid_program) simulation':
assumes step_sb: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ⇒⇩s⇩b⇩h (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b')"
assumes sim: "(ts⇩s⇩b,m⇩s⇩b,𝒮⇩s⇩b) ∼ (ts,m,𝒮)"
assumes inv: "invariant ts⇩s⇩b 𝒮⇩s⇩b m⇩s⇩b"
assumes safe_reach: "safe_reach_direct safe_delayed (ts,m,𝒮)"
shows "invariant ts⇩s⇩b' 𝒮⇩s⇩b' m⇩s⇩b' ∧
(∃ts' 𝒮' m'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧ (ts⇩s⇩b',m⇩s⇩b',𝒮⇩s⇩b') ∼ (ts',m',𝒮'))"
using inv sim safe_reach
apply (unfold invariant_def)
apply (simp only: conj_assoc)
apply (rule "concurrent_direct_steps_simulates_store_buffer_history_step" [OF step_sb])
apply simp_all
done
lemmas (in xvalid_program) simulation = conj_commI [OF simulation']
end
end
Theory PIMP
subsection ‹PIMP›
theory PIMP
imports ReduceStoreBufferSimulation
begin
datatype expr = Const val | Mem bool addr | Tmp sop
| Unop "val ⇒ val" expr
| Binop "val ⇒ val ⇒ val" expr expr
datatype stmt =
Skip
| Assign bool expr expr "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns"
| CAS expr expr expr "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns"
| Seq "stmt" "stmt"
| Cond expr "stmt" "stmt"
| While expr "stmt"
| SGhost "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns" "tmps ⇒ owns"
| SFence
primrec used_tmps:: "expr ⇒ nat"
where
"used_tmps (Const v) = 0"
| "used_tmps (Mem volatile addr) = 1"
| "used_tmps (Tmp sop) = 0"
| "used_tmps (Unop f e) = used_tmps e"
| "used_tmps (Binop f e⇩1 e⇩2) = used_tmps e⇩1 + used_tmps e⇩2"
primrec issue_expr:: "tmp ⇒ expr ⇒ instr list"
where
"issue_expr t (Const v) = []"
|"issue_expr t (Mem volatile a) = [Read volatile a t]"
|"issue_expr t (Tmp sop) = []"
|"issue_expr t (Unop f e) = issue_expr t e"
|"issue_expr t (Binop f e⇩1 e⇩2) = issue_expr t e⇩1 @ issue_expr (t + (used_tmps e⇩1)) e⇩2"
primrec eval_expr:: "tmp ⇒ expr ⇒ sop"
where
"eval_expr t (Const v) = ({},λθ. v)"
|"eval_expr t (Mem volatile a) = ({t},λθ. the (θ t))"
|"eval_expr t (Tmp sop) = sop"
|"eval_expr t (Unop f e) = (let (D,f⇩e) = eval_expr t e in (D,λθ. f (f⇩e θ))) "
|"eval_expr t (Binop f e⇩1 e⇩2) = (let (D⇩1,f⇩1) = eval_expr t e⇩1;
(D⇩2,f⇩2) = eval_expr (t + (used_tmps e⇩1)) e⇩2
in (D⇩1 ∪ D⇩2,λθ. f (f⇩1 θ) (f⇩2 θ)))"
primrec valid_sops_expr:: "nat ⇒ expr ⇒ bool"
where
"valid_sops_expr t (Const v) = True"
|"valid_sops_expr t (Mem volatile a) = True"
|"valid_sops_expr t (Tmp sop) = ((∀t' ∈ fst sop. t' < t) ∧ valid_sop sop)"
|"valid_sops_expr t (Unop f e) = valid_sops_expr t e"
|"valid_sops_expr t (Binop f e⇩1 e⇩2) = (valid_sops_expr t e⇩1 ∧ valid_sops_expr t e⇩2)"
primrec valid_sops_stmt:: "nat ⇒ stmt ⇒ bool"
where
"valid_sops_stmt t Skip = True"
|"valid_sops_stmt t (Assign volatile a e A L R W) = (valid_sops_expr t a ∧ valid_sops_expr t e)"
|"valid_sops_stmt t (CAS a c⇩e s⇩e A L R W) = (valid_sops_expr t a ∧ valid_sops_expr t c⇩e ∧
valid_sops_expr t s⇩e)"
|"valid_sops_stmt t (Seq s⇩1 s⇩2) = (valid_sops_stmt t s⇩1 ∧ valid_sops_stmt t s⇩2)"
|"valid_sops_stmt t (Cond e s⇩1 s⇩2) = (valid_sops_expr t e ∧ valid_sops_stmt t s⇩1 ∧ valid_sops_stmt t s⇩2)"
|"valid_sops_stmt t (While e s) = (valid_sops_expr t e ∧ valid_sops_stmt t s)"
|"valid_sops_stmt t (SGhost A L R W) = True"
|"valid_sops_stmt t SFence = True"
type_synonym stmt_config = "stmt × nat"
consts isTrue:: "val ⇒ bool"
inductive stmt_step:: "tmps ⇒ stmt_config ⇒ stmt_config × instrs ⇒ bool"
("_⊢ _ →⇩s _" [60,60,60] 100)
for θ
where
AssignAddr:
"∀sop. a ≠ Tmp sop ⟹
θ⊢ (Assign volatile a e A L R W, t) →⇩s
((Assign volatile (Tmp (eval_expr t a)) e A L R W, t + used_tmps a), issue_expr t a)"
| Assign:
"D ⊆ dom θ ⟹
θ⊢ (Assign volatile (Tmp (D,a)) e A L R W, t) →⇩s
((Skip, t + used_tmps e),
issue_expr t e@[Write volatile (a θ) (eval_expr t e) (A θ) (L θ) (R θ) (W θ)])"
| CASAddr:
"∀sop. a ≠ Tmp sop ⟹
θ⊢ (CAS a c⇩e s⇩e A L R W, t) →⇩s
((CAS (Tmp (eval_expr t a)) c⇩e s⇩e A L R W, t + used_tmps a), issue_expr t a)"
| CASComp:
"∀sop. c⇩e ≠ Tmp sop ⟹
θ⊢ (CAS (Tmp (D⇩a,a)) c⇩e s⇩e A L R W, t) →⇩s
((CAS (Tmp (D⇩a,a)) (Tmp (eval_expr t c⇩e)) s⇩e A L R W, t + used_tmps c⇩e), issue_expr t c⇩e)"
| CAS:
"⟦D⇩a ⊆ dom θ; D⇩c ⊆ dom θ; eval_expr t s⇩e = (D,f) ⟧
⟹
θ⊢ (CAS (Tmp (D⇩a,a)) (Tmp (D⇩c,c)) s⇩e A L R W, t) →⇩s
((Skip, Suc (t + used_tmps s⇩e)), issue_expr t s⇩e@
[RMW (a θ) (t + used_tmps s⇩e) (D,f) (λθ. the (θ (t + used_tmps s⇩e)) = c θ) (λv⇩1 v⇩2. v⇩1)
(A θ) (L θ) (R θ) (W θ) ])"
| Seq:
"θ⊢ (s⇩1, t) →⇩s ((s⇩1', t'), is)
⟹
θ⊢ (Seq s⇩1 s⇩2, t) →⇩s ((Seq s⇩1' s⇩2, t'),is)"
| SeqSkip:
"θ⊢ (Seq Skip s⇩2, t) →⇩s ((s⇩2, t), [])"
| Cond:
"∀sop. e ≠ Tmp sop
⟹
θ⊢ (Cond e s⇩1 s⇩2, t) →⇩s
((Cond (Tmp (eval_expr t e)) s⇩1 s⇩2, t + used_tmps e), issue_expr t e)"
| CondTrue:
"⟦D ⊆ dom θ; isTrue (e θ)⟧
⟹
θ⊢ (Cond (Tmp (D,e)) s⇩1 s⇩2, t) →⇩s ((s⇩1, t),[])"
| CondFalse:
"⟦D ⊆ dom θ; ¬ isTrue (e θ)⟧
⟹
θ⊢ (Cond (Tmp (D,e)) s⇩1 s⇩2, t) →⇩s ((s⇩2, t),[])"
| While:
"θ⊢ (While e s, t) →⇩s
((Cond e (Seq s (While e s)) Skip, t),[])"
| SGhost:
"θ⊢ (SGhost A L R W, t) →⇩s ((Skip, t),[Ghost (A θ) (L θ) (R θ) (W θ)])"
| SFence:
"θ⊢ (SFence, t) →⇩s ((Skip, t),[Fence])"
inductive_cases stmt_step_cases [cases set]:
"θ⊢ (Skip, t) →⇩s c"
"θ⊢ (Assign volatile a e A L R W, t) →⇩s c"
"θ⊢ (CAS a c⇩e s⇩e A L R W, t) →⇩s c"
"θ⊢ (Seq s⇩1 s⇩2, t) →⇩s c"
"θ⊢ (Cond e s⇩1 s⇩2, t) →⇩s c"
"θ⊢ (While e s, t) →⇩s c"
"θ⊢ (SGhost A L R W, t) →⇩s c"
"θ⊢ (SFence, t) →⇩s c"
lemma valid_sops_expr_mono: "⋀t t'. valid_sops_expr t e ⟹ t ≤ t' ⟹ valid_sops_expr t' e"
by (induct e) auto
lemma valid_sops_stmt_mono: "⋀t t'. valid_sops_stmt t s ⟹ t ≤ t' ⟹ valid_sops_stmt t' s"
by (induct s) (auto intro: valid_sops_expr_mono)
lemma valid_sops_expr_valid_sop: "⋀t. valid_sops_expr t e ⟹ valid_sop (eval_expr t e)"
proof (induct e)
case (Unop f e)
then obtain "valid_sops_expr t e"
by simp
from Unop.hyps [OF this]
have vs: "valid_sop (eval_expr t e)"
by simp
obtain D g where eval_e: "eval_expr t e = (D,g)"
by (cases "eval_expr t e")
interpret valid_sop "(D,g)"
using vs eval_e
by simp
show ?case
apply (clarsimp simp add: Let_def valid_sop_def eval_e)
apply (drule valid_sop [OF refl])
apply simp
done
next
case (Binop f e⇩1 e⇩2)
then obtain v1: "valid_sops_expr t e⇩1" and v2: "valid_sops_expr t e⇩2"
by simp
with Binop.hyps (1) [of t] Binop.hyps (2) [of "(t + used_tmps e⇩1)"]
valid_sops_expr_mono [OF v2, of "(t + used_tmps e⇩1)"]
obtain vs1: "valid_sop (eval_expr t e⇩1)" and vs2: "valid_sop (eval_expr (t + used_tmps e⇩1) e⇩2)"
by auto
obtain D⇩1 g⇩1 where eval_e⇩1: "eval_expr t e⇩1 = (D⇩1,g⇩1)"
by (cases "eval_expr t e⇩1")
obtain D⇩2 g⇩2 where eval_e⇩2: "eval_expr (t + used_tmps e⇩1) e⇩2 = (D⇩2,g⇩2)"
by (cases "eval_expr (t + used_tmps e⇩1) e⇩2")
interpret vs1: valid_sop "(D⇩1,g⇩1)"
using vs1 eval_e⇩1 by auto
interpret vs2: valid_sop "(D⇩2,g⇩2)"
using vs2 eval_e⇩2 by auto
{
fix θ:: "nat⇒val option"
assume D1: "D⇩1 ⊆ dom θ"
assume D2: "D⇩2 ⊆ dom θ"
have "f (g⇩1 θ) (g⇩2 θ) = f (g⇩1 (θ |` (D⇩1 ∪ D⇩2))) (g⇩2 (θ |` (D⇩1 ∪ D⇩2)))"
proof -
from vs1.valid_sop [OF refl D1]
have "g⇩1 θ = g⇩1 (θ |` D⇩1)".
also
from D1 have D1': "D⇩1 ⊆ dom (θ |` (D⇩1 ∪ D⇩2))"
by auto
have "θ |` (D⇩1 ∪ D⇩2) |` D⇩1 = θ |` D⇩1"
apply (rule ext)
apply (auto simp add: restrict_map_def)
done
with vs1.valid_sop [OF refl D1']
have "g⇩1 (θ |` D⇩1) = g⇩1 (θ |` (D⇩1 ∪ D⇩2))"
by auto
finally have g1: "g⇩1 (θ |` (D⇩1 ∪ D⇩2)) = g⇩1 θ"
by simp
from vs2.valid_sop [OF refl D2]
have "g⇩2 θ = g⇩2 (θ |` D⇩2)".
also
from D2 have D2': "D⇩2 ⊆ dom (θ |` (D⇩1 ∪ D⇩2))"
by auto
have "θ |` (D⇩1 ∪ D⇩2) |` D⇩2 = θ |` D⇩2"
apply (rule ext)
apply (auto simp add: restrict_map_def)
done
with vs2.valid_sop [OF refl D2']
have "g⇩2 (θ |` D⇩2) = g⇩2 (θ |` (D⇩1 ∪ D⇩2))"
by auto
finally have g2: "g⇩2 (θ |` (D⇩1 ∪ D⇩2)) = g⇩2 θ"
by simp
from g1 g2 show ?thesis by simp
qed
}
note lem=this
show ?case
apply (clarsimp simp add: Let_def valid_sop_def eval_e⇩1 eval_e⇩2)
apply (rule lem)
by auto
qed (auto simp add: valid_sop_def)
lemma valid_sops_expr_eval_expr_in_range:
"⋀t. valid_sops_expr t e ⟹ ∀t' ∈ fst (eval_expr t e). t' < t + used_tmps e"
proof (induct e)
case (Unop f e)
thus ?case
apply (cases "eval_expr t e")
apply auto
done
next
case (Binop f e⇩1 e⇩2)
then obtain v1: "valid_sops_expr t e⇩1" and v2: "valid_sops_expr t e⇩2"
by simp
from valid_sops_expr_mono [OF v2]
have v2': "valid_sops_expr (t + used_tmps e⇩1) e⇩2"
by auto
from Binop.hyps (1) [OF v1] Binop.hyps (2) [OF v2']
show ?case
apply (cases "eval_expr t e⇩1")
apply (cases "eval_expr (t + used_tmps e⇩1) e⇩2")
apply auto
done
qed auto
lemma stmt_step_tmps_count_mono:
assumes step: "θ⊢ (s,t) →⇩s ((s',t'),is)"
shows "t ≤ t'"
using step
by (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct) force+
lemma valid_sops_stmt_invariant:
assumes step: "θ⊢ (s,t) →⇩s ((s',t'),is)"
shows "valid_sops_stmt t s ⟹ valid_sops_stmt t' s'"
using step
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
case AssignAddr thus ?case by
(force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono
dest: valid_sops_expr_eval_expr_in_range)
next
case Assign thus ?case by simp
next
case CASAddr thus ?case by
(force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono
dest: valid_sops_expr_eval_expr_in_range)
next
case CASComp thus ?case by
(force simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono valid_sops_expr_mono
dest: valid_sops_expr_eval_expr_in_range)
next
case CAS thus ?case by simp
next
case Seq thus ?case by (force intro: valid_sops_stmt_mono dest: stmt_step_tmps_count_mono)
next
case SeqSkip thus ?case by auto
next
case Cond thus ?case
by (fastforce simp add: valid_sops_expr_valid_sop intro: valid_sops_stmt_mono
dest: valid_sops_expr_eval_expr_in_range)
next
case CondTrue thus ?case by force
next
case CondFalse thus ?case by force
next
case While thus ?case by auto
next
case SGhost thus ?case by simp
next
case SFence thus ?case by simp
qed
lemma map_le_restrict_map_eq: "m⇩1 ⊆⇩m m⇩2 ⟹ D ⊆ dom m⇩1 ⟹ m⇩2 |` D = m⇩1 |` D"
apply (rule ext)
apply (force simp add: restrict_map_def map_le_def)
done
lemma sbh_step_preserves_load_tmps_bound:
assumes step: "(is,𝒪,𝒟,θ,sb,𝒮,m) →⇩s⇩b⇩h (is',𝒪',𝒟',θ',sb',𝒮',m')"
assumes less: "∀i ∈ load_tmps is. i < n"
shows "∀i ∈ load_tmps is'. i < n"
using step less
by cases auto
lemma sbh_step_preserves_read_tmps_bound:
assumes step: "(is,θ,sb,m,𝒟,𝒪,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',𝒮')"
assumes less_is: "∀i ∈ load_tmps is. i < n"
assumes less_sb: "∀i ∈ read_tmps sb. i < n"
shows "∀i ∈ read_tmps sb'. i < n"
using step less_is less_sb
by cases (auto simp add: read_tmps_append)
lemma sbh_step_preserves_tmps_bound:
assumes step: "(is,θ,sb,m,𝒟,𝒪,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',𝒮')"
assumes less_dom: "∀i ∈ dom θ. i < n"
assumes less_is: "∀i ∈ load_tmps is. i < n"
shows "∀i ∈ dom θ'. i < n"
using step less_dom less_is
by cases (auto simp add: read_tmps_append)
lemma flush_step_preserves_read_tmps:
assumes step: "(m,sb,𝒪) →⇩f (m',sb',𝒪')"
assumes less_sb: "∀i ∈ read_tmps sb. i < n"
shows "∀i ∈ read_tmps sb'. i < n"
using step less_sb
by cases (auto simp add: read_tmps_append)
lemma flush_step_preserves_write_sops:
assumes step: "(m,sb,𝒪) →⇩f (m',sb',𝒪')"
assumes less_sb: "∀i∈⋃(fst ` write_sops sb). i < t"
shows "∀i∈⋃(fst ` write_sops sb'). i < t"
using step less_sb
by cases (auto simp add: read_tmps_append)
lemma issue_expr_load_tmps_range':
"⋀t. load_tmps (issue_expr t e) = {i. t ≤ i ∧ i < t + used_tmps e}"
apply (induct e)
apply (force simp add: load_tmps_append)+
done
lemma issue_expr_load_tmps_range:
"⋀t. ∀i ∈ load_tmps (issue_expr t e). t ≤ i ∧ i < t + (used_tmps e)"
by (auto simp add: issue_expr_load_tmps_range')
lemma stmt_step_load_tmps_range':
assumes step: "θ⊢ (s, t) →⇩s ((s', t'),is)"
shows "load_tmps is = {i. t ≤ i ∧ i < t'}"
using step
apply (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
apply (force simp add: load_tmps_append simp add: issue_expr_load_tmps_range')+
done
lemma stmt_step_load_tmps_range:
assumes step: "θ⊢ (s, t) →⇩s ((s', t'),is)"
shows "∀i ∈ load_tmps is. t ≤ i ∧ i < t'"
using stmt_step_load_tmps_range' [OF step]
by auto
lemma distinct_load_tmps_issue_expr: "⋀t. distinct_load_tmps (issue_expr t e)"
apply (induct e)
apply (auto simp add: distinct_load_tmps_append dest!: issue_expr_load_tmps_range [rule_format])
done
lemma max_used_load_tmps: "t + used_tmps e ∉ load_tmps (issue_expr t e)"
proof -
from issue_expr_load_tmps_range [rule_format, of "t+used_tmps e"]
show ?thesis
by auto
qed
lemma stmt_step_distinct_load_tmps:
assumes step: "θ⊢ (s, t) →⇩s ((s', t'),is)"
shows "distinct_load_tmps is"
using step
apply (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
apply (force simp add: distinct_load_tmps_append distinct_load_tmps_issue_expr max_used_load_tmps)+
done
lemma store_sops_issue_expr [simp]: "⋀t. store_sops (issue_expr t e) = {}"
apply (induct e)
apply (auto simp add: store_sops_append)
done
lemma stmt_step_data_store_sops_range:
assumes step: "θ⊢ (s, t) →⇩s ((s', t'),is)"
assumes valid: "valid_sops_stmt t s"
shows "∀(D,f) ∈ store_sops is. ∀i ∈ D. i < t'"
using step valid
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
case AssignAddr
thus ?case
by auto
next
case (Assign D volatile a e)
thus ?case
apply (cases "eval_expr t e")
apply (auto simp add: store_sops_append intro: valid_sops_expr_eval_expr_in_range [rule_format])
done
next
case CASAddr
thus ?case
by auto
next
case CASComp
thus ?case
by auto
next
case (CAS _ _ D f a A L R)
thus ?case
by (fastforce simp add: store_sops_append dest: valid_sops_expr_eval_expr_in_range [rule_format])
next
case Seq
thus ?case
by (force intro: valid_sops_stmt_mono )
next
case SeqSkip thus ?case by simp
next
case Cond thus ?case
by auto
next
case CondTrue thus ?case by auto
next
case CondFalse thus ?case by auto
next
case While thus ?case by auto
next
case SGhost thus ?case by auto
next
case SFence thus ?case by auto
qed
lemma sbh_step_distinct_load_tmps_prog_step:
assumes step: "θ⊢(s,t) →⇩s ((s',t'),is')"
assumes load_tmps_le: "∀i ∈ load_tmps is. i < t"
assumes read_tmps_le: "∀i ∈ read_tmps sb. i < t"
shows "distinct_load_tmps is' ∧ (load_tmps is' ∩ load_tmps is = {}) ∧
(load_tmps is' ∩ read_tmps sb) = {}"
proof -
from stmt_step_load_tmps_range [OF step] stmt_step_distinct_load_tmps [OF step]
load_tmps_le read_tmps_le
show ?thesis
by force
qed
lemma data_dependency_consistent_instrs_issue_expr:
"⋀t T. data_dependency_consistent_instrs T (issue_expr t e)"
apply (induct e)
apply (auto simp add: data_dependency_consistent_instrs_append
dest!: issue_expr_load_tmps_range [rule_format]
)
done
lemma dom_eval_expr:
"⋀t. ⟦valid_sops_expr t e; x ∈ fst (eval_expr t e)⟧ ⟹ x ∈ {i. i < t} ∪ load_tmps (issue_expr t e)"
proof (induct e)
case Const thus ?case by simp
next
case Mem thus ?case by simp
next
case Tmp thus ?case by simp
next
case (Unop f e)
thus ?case
by (cases "eval_expr t e") auto
next
case (Binop f e1 e2)
then obtain valid1: "valid_sops_expr t e1" and valid2: "valid_sops_expr t e2"
by auto
from valid_sops_expr_mono [OF valid2] have valid2': "valid_sops_expr (t+used_tmps e1) e2"
by auto
from Binop.hyps (1) [OF valid1] Binop.hyps (2) [OF valid2'] Binop.prems
show ?case
apply (case_tac "eval_expr t e1")
apply (case_tac "eval_expr (t+used_tmps e1) e2")
apply (auto simp add: load_tmps_append issue_expr_load_tmps_range')
done
qed
lemma Cond_not_s⇩1: "s⇩1 ≠ Cond e s⇩1 s⇩2 "
by (induct s⇩1) auto
lemma Cond_not_s⇩2: "s⇩2 ≠ Cond e s⇩1 s⇩2 "
by (induct s⇩2) auto
lemma Seq_not_s⇩1: "s⇩1 ≠ Seq s⇩1 s⇩2"
by (induct s⇩1) auto
lemma Seq_not_s⇩2: "s⇩2 ≠ Seq s⇩1 s⇩2"
by (induct s⇩2) auto
lemma prog_step_progress:
assumes step: "θ⊢(s,t) →⇩s ((s',t'),is)"
shows "(s',t') ≠ (s,t) ∨ is ≠ []"
using step
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
case (AssignAddr a _ _ _ _ _ _ t) thus ?case
by (cases "eval_expr t a") auto
next
case Assign thus ?case by auto
next
case (CASAddr a _ _ _ _ _ _ t) thus ?case by (cases "eval_expr t a") auto
next
case (CASComp c⇩e _ _ _ _ _ _ _ t) thus ?case by (cases "eval_expr t c⇩e") auto
next
case CAS thus ?case by auto
next
case (Cond e _ _ t) thus ?case by (cases "eval_expr t e") auto
next
case CondTrue thus ?case using Cond_not_s⇩1 by auto
next
case CondFalse thus ?case using Cond_not_s⇩2 by auto
next
case Seq thus ?case by force
next
case SeqSkip thus ?case using Seq_not_s⇩2 by auto
next
case While thus ?case by auto
next
case SGhost thus ?case by auto
next
case SFence thus ?case by auto
qed
lemma stmt_step_data_dependency_consistent_instrs:
assumes step: "θ⊢ (s, t) →⇩s ((s', t'),is)"
assumes valid: "valid_sops_stmt t s"
shows "data_dependency_consistent_instrs ({i. i < t}) is"
using step valid
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" T rule: stmt_step.induct)
case AssignAddr
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case Assign
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case CASAddr
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case CASComp
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case CAS
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case Seq
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append)
next
case SeqSkip thus ?case by auto
next
case Cond
thus ?case
by (fastforce simp add: simp add: data_dependency_consistent_instrs_append
data_dependency_consistent_instrs_issue_expr load_tmps_append
dest: dom_eval_expr)
next
case CondTrue thus ?case by auto
next
case CondFalse thus ?case by auto
next
case While
thus ?case by auto
next
case SGhost thus ?case by auto
next
case SFence thus ?case by auto
qed
lemma sbh_valid_data_dependency_prog_step:
assumes step: "θ⊢(s,t) →⇩s ((s',t'),is')"
assumes store_sops_le: "∀i ∈ ⋃(fst ` store_sops is). i < t"
assumes write_sops_le: "∀i ∈ ⋃(fst ` write_sops sb). i < t"
assumes valid: "valid_sops_stmt t s"
shows "data_dependency_consistent_instrs ({i. i < t}) is' ∧
load_tmps is' ∩ ⋃(fst ` store_sops is) = {} ∧
load_tmps is' ∩ ⋃(fst ` write_sops sb) = {}"
proof -
from stmt_step_data_dependency_consistent_instrs [OF step valid] stmt_step_load_tmps_range [OF step]
store_sops_le write_sops_le
show ?thesis
by fastforce
qed
lemma sbh_load_tmps_fresh_prog_step:
assumes step: "θ⊢(s,t) →⇩s ((s',t'),is')"
assumes tmps_le: "∀i ∈ dom θ. i < t"
shows "load_tmps is' ∩ dom θ = {}"
proof -
from stmt_step_load_tmps_range [OF step] tmps_le
show ?thesis
apply auto
subgoal for x
apply (drule_tac x=x in bspec )
apply assumption
apply (drule_tac x=x in bspec )
apply fastforce
apply simp
done
done
qed
lemma sbh_valid_sops_prog_step:
assumes step: "θ⊢(s,t) →⇩s ((s',t'),is)"
assumes valid: "valid_sops_stmt t s"
shows "∀sop∈store_sops is. valid_sop sop"
using step valid
proof (induct x=="(s,t)" y=="((s',t'),is)" arbitrary: s t s' t' "is" rule: stmt_step.induct)
case AssignAddr
thus ?case by auto
next
case Assign
thus ?case
by (auto simp add: store_sops_append valid_sops_expr_valid_sop)
next
case CASAddr
thus ?case by auto
next
case CASComp
thus ?case by auto
next
case CAS
thus ?case
by (fastforce simp add: store_sops_append dest: valid_sops_expr_valid_sop)
next
case Seq
thus ?case
by (force intro: valid_sops_stmt_mono )
next
case SeqSkip thus ?case by simp
next
case Cond thus ?case
by auto
next
case CondTrue thus ?case by auto
next
case CondFalse thus ?case by auto
next
case While thus ?case by auto
next
case SGhost thus ?case by auto
next
case SFence thus ?case by auto
qed
primrec prog_configs:: "'a memref list ⇒ 'a set"
where
"prog_configs [] = {}"
|"prog_configs (x#xs) = (case x of
Prog⇩s⇩b p p' is ⇒ {p,p'} ∪ prog_configs xs
| _ ⇒ prog_configs xs)"
lemma prog_configs_append: "⋀ys. prog_configs (xs@ys) = prog_configs xs ∪ prog_configs ys"
by (induct xs) (auto split: memref.splits)
lemma prog_configs_in1: "Prog⇩s⇩b p⇩1 p⇩2 is ∈ set xs ⟹ p⇩1 ∈ prog_configs xs"
by (induct xs) (auto split: memref.splits)
lemma prog_configs_in2: "Prog⇩s⇩b p⇩1 p⇩2 is ∈ set xs ⟹ p⇩2 ∈ prog_configs xs"
by (induct xs) (auto split: memref.splits)
lemma prog_configs_mono: "⋀ys. set xs ⊆ set ys ⟹ prog_configs xs ⊆ prog_configs ys"
by (induct xs) (auto split: memref.splits simp add: prog_configs_append
prog_configs_in1 prog_configs_in2)
locale separated_tmps =
fixes ts
assumes valid_sops_stmt: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ valid_sops_stmt t s"
assumes valid_sops_stmt_sb: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪); (s',t') ∈ prog_configs sb⟧
⟹ valid_sops_stmt t' s'"
assumes load_tmps_le: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ ∀i ∈ load_tmps is. i < t"
assumes read_tmps_le: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ ∀i ∈ read_tmps sb. i < t"
assumes store_sops_le: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ ∀i ∈ ⋃(fst ` store_sops is). i < t"
assumes write_sops_le: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ ∀i ∈ ⋃(fst ` write_sops sb). i < t"
assumes tmps_le: "⟦i < length ts; ts!i = ((s,t),is,θ,sb,𝒟,𝒪)⟧
⟹ dom θ ∪ load_tmps is = {i. i < t}"
lemma (in separated_tmps)
tmps_le':
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = ((s,t),is,θ,sb,𝒟,𝒪)"
shows "∀i ∈ dom θ. i < t"
using tmps_le [OF i_bound ts_i] by auto
lemma (in separated_tmps) separated_tmps_nth_update:
"⟦i < length ts; valid_sops_stmt t s; ∀(s',t') ∈ prog_configs sb. valid_sops_stmt t' s';
∀i ∈ load_tmps is. i < t;∀i ∈ read_tmps sb. i < t;
∀i ∈ ⋃(fst ` store_sops is). i < t; ∀i ∈ ⋃(fst ` write_sops sb). i < t; dom θ ∪ load_tmps is = {i. i < t}⟧
⟹
separated_tmps (ts[i:=((s,t),is,θ,sb,𝒟,𝒪)])"
apply (unfold_locales)
apply (force intro: valid_sops_stmt simp add: nth_list_update split: if_split_asm)
apply (fastforce intro: valid_sops_stmt_sb simp add: nth_list_update split: if_split_asm)
apply (fastforce intro: load_tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
apply (fastforce intro: read_tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
apply (fastforce intro: store_sops_le [rule_format] simp add: nth_list_update split: if_split_asm)
apply (fastforce intro: write_sops_le [rule_format] simp add: nth_list_update split: if_split_asm)
apply (fastforce dest: tmps_le [rule_format] simp add: nth_list_update split: if_split_asm)
done
lemma hd_prog_app_in_first: "⋀ys. Prog⇩s⇩b p p' is ∈ set xs ⟹ hd_prog q (xs @ ys) = hd_prog q xs"
by (induct xs) (auto split: memref.splits)
lemma hd_prog_app_in_eq: "⋀ys. Prog⇩s⇩b p p' is ∈ set xs ⟹ hd_prog q xs = hd_prog x xs"
by (induct xs) (auto split: memref.splits)
lemma hd_prog_app_notin_first: "⋀ys. ∀p p' is. Prog⇩s⇩b p p' is ∉ set xs ⟹ hd_prog q (xs @ ys) = hd_prog q ys"
by (induct xs) (auto split: memref.splits)
lemma union_eq_subsetD: "A ∪ B = C ⟹ A ∪ B ⊆ C ∧ C ⊆ A ∪ B"
by auto
lemma prog_step_preserves_separated_tmps:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪)"
assumes prog_step: "θ⊢ p →⇩s (p', is')"
assumes sep: "separated_tmps ts"
shows "separated_tmps
(ts [i:=(p',is@is',θ,sb@[Prog⇩s⇩b p p' is'],𝒟,𝒪)])"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
obtain s' t' where p': "p'=(s',t')" by (cases p')
note ts_i = ts_i [simplified p]
note step = prog_step [simplified p p']
interpret separated_tmps ts by fact
have "separated_tmps (ts[i := ((s',t'), is @ is', θ,
sb @ [Prog⇩s⇩b (s,t) (s',t') is'], 𝒟,𝒪)])"
proof (rule separated_tmps_nth_update [OF i_bound])
from stmt_step_load_tmps_range [OF step] load_tmps_le [OF i_bound ts_i]
stmt_step_tmps_count_mono [OF step]
show "∀i∈load_tmps (is @ is'). i < t'"
by (auto simp add: load_tmps_append)
next
from read_tmps_le [OF i_bound ts_i] stmt_step_tmps_count_mono [OF step]
show "∀i∈read_tmps (sb @ [Prog⇩s⇩b (s, t) (s', t') is']). i < t'"
by (auto simp add: read_tmps_append)
next
from stmt_step_data_store_sops_range [OF step] stmt_step_tmps_count_mono [OF step]
store_sops_le [OF i_bound ts_i] valid_sops_stmt [OF i_bound ts_i]
show "∀i∈⋃(fst ` store_sops (is @ is')). i < t'"
by (fastforce simp add: store_sops_append)
next
from
stmt_step_tmps_count_mono [OF step] write_sops_le [OF i_bound ts_i]
show "∀i∈⋃(fst ` write_sops (sb @ [Prog⇩s⇩b (s, t) (s', t') is'])). i < t'"
by (fastforce simp add: write_sops_append)
next
from tmps_le [OF i_bound ts_i]
have "dom θ ∪ load_tmps is = {i. i < t}" by simp
with stmt_step_load_tmps_range' [OF step] stmt_step_tmps_count_mono [OF step]
show "dom θ ∪ load_tmps (is @ is') = {i. i < t'}"
apply (clarsimp simp add: load_tmps_append)
apply rule
apply (drule union_eq_subsetD)
apply fastforce
apply clarsimp
subgoal for x
apply (case_tac "t ≤ x")
apply simp
apply (subgoal_tac "x < t")
apply fastforce
apply fastforce
done
done
next
from valid_sops_stmt_invariant [OF prog_step [simplified p p'] valid_sops_stmt [OF i_bound ts_i]]
show "valid_sops_stmt t' s'".
next
show "∀(s', t')∈prog_configs (sb @ [Prog⇩s⇩b (s, t) (s', t') is']).
valid_sops_stmt t' s'"
proof -
{
fix s⇩1 t⇩1
assume cfgs: "(s⇩1,t⇩1) ∈ prog_configs (sb @ [Prog⇩s⇩b (s, t) (s', t') is'])"
have "valid_sops_stmt t⇩1 s⇩1"
proof -
from valid_sops_stmt [OF i_bound ts_i]
have "valid_sops_stmt t s".
moreover
from valid_sops_stmt_invariant [OF prog_step [simplified p p'] valid_sops_stmt [OF i_bound ts_i]]
have "valid_sops_stmt t' s'".
moreover
note valid_sops_stmt_sb [OF i_bound ts_i]
ultimately
show ?thesis
using cfgs
by (auto simp add: prog_configs_append)
qed
}
thus ?thesis
by auto
qed
qed
then
show ?thesis
by (simp add: p p')
qed
lemma flush_step_sb_subset:
assumes step: "(m,sb,𝒪) →⇩f (m', sb',𝒪')"
shows "set sb' ⊆ set sb"
using step
apply (induct c1=="(m,sb,𝒪)" c2=="(m',sb',𝒪')" arbitrary: m sb 𝒪 acq m' sb' 𝒪' acq
rule: flush_step.induct)
apply auto
done
lemma flush_step_preserves_separated_tmps:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes flush_step: "(m,sb,𝒪,ℛ,𝒮) →⇩f (m', sb',𝒪',ℛ',𝒮')"
assumes sep: "separated_tmps ts"
shows "separated_tmps (ts [i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
note ts_i = ts_i [simplified p]
interpret separated_tmps ts by fact
have "separated_tmps (ts [i:=((s,t),is,θ,sb',𝒟,𝒪',ℛ')])"
proof (rule separated_tmps_nth_update [OF i_bound])
from load_tmps_le [OF i_bound ts_i]
show "∀i∈load_tmps is. i < t".
next
from flush_step_preserves_read_tmps [OF flush_step read_tmps_le [OF i_bound ts_i] ]
show "∀i∈read_tmps sb'. i < t".
next
from store_sops_le [OF i_bound ts_i]
show "∀i∈⋃(fst ` store_sops is). i < t".
next
from flush_step_preserves_write_sops [OF flush_step write_sops_le [OF i_bound ts_i]]
show "∀i∈⋃(fst ` write_sops sb'). i < t".
next
from tmps_le [OF i_bound ts_i]
show "dom θ ∪ load_tmps is = {i. i < t}"
by auto
next
from valid_sops_stmt [OF i_bound ts_i]
show "valid_sops_stmt t s".
next
from valid_sops_stmt_sb [OF i_bound ts_i] flush_step_sb_subset [OF flush_step]
show "∀(s', t')∈prog_configs sb'. valid_sops_stmt t' s'"
by (auto dest!: prog_configs_mono)
qed
then
show ?thesis
by (simp add: p)
qed
lemma sbh_step_preserves_store_sops_bound:
assumes step: "(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
assumes store_sops_le: "∀i∈⋃(fst ` store_sops is). i < t"
shows "∀i∈⋃(fst ` store_sops is'). i < t"
using step store_sops_le
by cases auto
lemma sbh_step_preserves_write_sops_bound:
assumes step: "(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
assumes store_sops_le: "∀i∈⋃(fst ` store_sops is). i < t"
assumes write_sops_le: "∀i∈⋃(fst ` write_sops sb). i < t"
shows "∀i∈⋃(fst ` write_sops sb'). i < t"
using step store_sops_le write_sops_le
by cases (auto simp add: write_sops_append)
lemma sbh_step_prog_configs_eq:
assumes step: "(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
shows "prog_configs sb' = prog_configs sb"
using step
apply (cases)
apply (auto simp add: prog_configs_append)
done
lemma sbh_step_preserves_tmps_bound':
assumes step: "(is,θ,sb,m,𝒟,𝒪,ℛ,𝒮) →⇩s⇩b⇩h (is',θ',sb',m',𝒟',𝒪',ℛ',𝒮')"
shows "dom θ ∪ load_tmps is = dom θ' ∪ load_tmps is'"
using step
apply cases
apply (auto simp add: read_tmps_append)
done
lemma sbh_step_preserves_separated_tmps:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"
assumes memop_step: "(is, θ, sb, m,𝒟, 𝒪, ℛ,𝒮) →⇩s⇩b⇩h
(is', θ', sb', m',𝒟', 𝒪', ℛ',𝒮')"
assumes instr: "separated_tmps ts"
shows "separated_tmps (ts [i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
note ts_i = ts_i [simplified p]
interpret separated_tmps ts by fact
have "separated_tmps (ts [i:=((s,t),is',θ',sb',𝒟',𝒪',ℛ')])"
proof (rule separated_tmps_nth_update [OF i_bound])
from sbh_step_preserves_load_tmps_bound [OF memop_step load_tmps_le [OF i_bound ts_i]]
show "∀i∈load_tmps is'. i < t".
next
from sbh_step_preserves_read_tmps_bound [OF memop_step load_tmps_le [OF i_bound ts_i]
read_tmps_le [OF i_bound ts_i]]
show "∀i∈read_tmps sb'. i < t".
next
from sbh_step_preserves_store_sops_bound [OF memop_step store_sops_le [OF i_bound ts_i]]
show "∀i∈⋃(fst ` store_sops is'). i < t".
next
from sbh_step_preserves_write_sops_bound [OF memop_step store_sops_le [OF i_bound ts_i]
write_sops_le [OF i_bound ts_i]]
show "∀i∈⋃(fst ` write_sops sb'). i < t".
next
from sbh_step_preserves_tmps_bound' [OF memop_step] tmps_le [OF i_bound ts_i]
show "dom θ' ∪ load_tmps is' = {i. i < t}"
by auto
next
from valid_sops_stmt [OF i_bound ts_i]
show "valid_sops_stmt t s".
next
from valid_sops_stmt_sb [OF i_bound ts_i] sbh_step_prog_configs_eq [OF memop_step]
show "∀(s', t')∈prog_configs sb'. valid_sops_stmt t' s'"
by auto
qed
then show ?thesis
by (simp add: p)
qed
definition
"valid_pimp ts ≡ separated_tmps ts"
lemma prog_step_preserves_valid:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,ℛ)"
assumes prog_step: "θ⊢ p →⇩s (p', is')"
assumes valid: "valid_pimp ts"
shows "valid_pimp (ts [i:=(p',is@is',θ,sb@[Prog⇩s⇩b p p' is'],𝒟,𝒪,ℛ)])"
using prog_step_preserves_separated_tmps [OF i_bound ts_i prog_step] valid
by (auto simp add: valid_pimp_def)
lemma flush_step_preserves_valid:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,ℛ)"
assumes flush_step: "(m,sb,𝒪,ℛ,𝒮) →⇩f (m', sb',𝒪',ℛ',𝒮')"
assumes valid: "valid_pimp ts"
shows "valid_pimp (ts [i:=(p,is,θ,sb',𝒟,𝒪',ℛ')])"
using flush_step_preserves_separated_tmps [OF i_bound ts_i flush_step] valid
by (auto simp add: valid_pimp_def)
lemma sbh_step_preserves_valid:
assumes i_bound: "i < length ts"
assumes ts_i: "ts!i = (p,is,θ,sb::stmt_config store_buffer,𝒟,𝒪,ℛ)"
assumes memop_step: "(is, θ, sb, m,𝒟, 𝒪, ℛ,𝒮) →⇩s⇩b⇩h
(is', θ', sb', m',𝒟', 𝒪', ℛ', 𝒮')"
assumes valid: "valid_pimp ts"
shows "valid_pimp (ts [i:=(p,is',θ',sb',𝒟',𝒪',ℛ')])"
using
sbh_step_preserves_separated_tmps [OF i_bound ts_i memop_step] valid
by (auto simp add: valid_pimp_def)
lemma hd_prog_prog_configs: "hd_prog p sb = p ∨ hd_prog p sb ∈ prog_configs sb"
by (induct sb) (auto split:memref.splits)
interpretation PIMP: xvalid_program_progress stmt_step "λ(s,t). valid_sops_stmt t s" valid_pimp
proof
fix θ p p' is'
assume step: "θ⊢ p →⇩s (p', is')"
obtain s t where p: "p = (s,t)"
by (cases p)
obtain s' t' where p': "p' = (s',t')"
by (cases p')
from prog_step_progress [OF step [simplified p p']]
show "p' ≠ p ∨ is' ≠ []"
by (simp add: p p')
next
fix θ p p' is'
assume step: "θ⊢ p →⇩s (p', is')"
and valid_stmt: "(λ(s, t). valid_sops_stmt t s) p"
obtain s t where p: "p = (s,t)"
by (cases p)
obtain s' t' where p': "p' = (s',t')"
by (cases p')
from valid_sops_stmt_invariant [OF step [simplified p p'] valid_stmt [simplified p, simplified]]
have "valid_sops_stmt t' s'".
then show "(λ(s, t). valid_sops_stmt t s) p'" by (simp add: p')
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb::(stmt × nat) memref list, 𝒟, 𝒪,ℛ)"
and valid: "valid_pimp ts"
from valid have "separated_tmps ts"
by (simp add: valid_pimp_def)
then interpret separated_tmps ts .
obtain s t where p: "p = (s,t)"
by (cases p)
from valid_sops_stmt [OF i_bound ts_i [simplified p]]
show "(λ(s, t). valid_sops_stmt t s) p"
by (auto simp add: p)
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb::(stmt × nat) memref list, 𝒟, 𝒪,ℛ)"
and valid: "valid_pimp ts"
from valid have "separated_tmps ts"
by (simp add: valid_pimp_def)
then interpret separated_tmps ts .
obtain s t where p: "p = (s,t)"
by (cases p)
from hd_prog_prog_configs [of p sb] valid_sops_stmt [OF i_bound ts_i [simplified p]]
valid_sops_stmt_sb [OF i_bound ts_i [simplified p]]
show "(λ(s, t). valid_sops_stmt t s) (hd_prog p sb)"
by (auto simp add: p)
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb p' is'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ)"
and step: "θ⊢ p →⇩s (p', is')"
and valid: "valid_pimp ts"
show "distinct_load_tmps is' ∧
load_tmps is' ∩ load_tmps is = {} ∧
load_tmps is' ∩ read_tmps sb = {}"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
obtain s' t' where p': "p'=(s',t')" by (cases p')
note ts_i = ts_i [simplified p]
note step = step [simplified p p']
from valid
interpret separated_tmps ts
by (simp add: valid_pimp_def)
from sbh_step_distinct_load_tmps_prog_step [OF step load_tmps_le [OF i_bound ts_i]
read_tmps_le [OF i_bound ts_i]]
show ?thesis .
qed
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb p' is'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ)"
and step: "θ⊢ p →⇩s (p', is')"
and valid: "valid_pimp ts"
show "data_dependency_consistent_instrs (dom θ ∪ load_tmps is) is' ∧
load_tmps is' ∩ ⋃(fst ` store_sops is) = {} ∧
load_tmps is' ∩ ⋃(fst ` write_sops sb) = {}"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
obtain s' t' where p': "p'=(s',t')" by (cases p')
note ts_i = ts_i [simplified p]
note step = step [simplified p p']
from valid
interpret separated_tmps ts
by (simp add: valid_pimp_def)
from sbh_valid_data_dependency_prog_step [OF step store_sops_le [OF i_bound ts_i]
write_sops_le [OF i_bound ts_i] valid_sops_stmt [OF i_bound ts_i]] tmps_le [OF i_bound ts_i]
show ?thesis by auto
qed
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb p' is'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb, 𝒟, 𝒪,ℛ)"
and step: "θ⊢ p →⇩s (p', is')"
and valid: "valid_pimp ts"
show "load_tmps is' ∩ dom θ = {}"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
obtain s' t' where p': "p'=(s',t')" by (cases p')
note ts_i = ts_i [simplified p]
note step = step [simplified p p']
from valid
interpret separated_tmps ts
by (simp add: valid_pimp_def)
from sbh_load_tmps_fresh_prog_step [OF step tmps_le' [OF i_bound ts_i]]
show ?thesis .
qed
next
fix θ p p' "is"
assume step: "θ⊢ p →⇩s (p', is)"
and valid: "(λ(s, t). valid_sops_stmt t s) p"
show "∀sop∈store_sops is. valid_sop sop"
proof -
obtain s t where p: "p=(s,t)" by (cases p)
obtain s' t' where p': "p'=(s',t')" by (cases p')
note step = step [simplified p p']
from sbh_valid_sops_prog_step [OF step valid [simplified p,simplified]]
show ?thesis .
qed
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb p' is'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,ℛ)"
and step: "θ⊢ p →⇩s (p', is')"
and valid: "valid_pimp ts"
from prog_step_preserves_valid [OF i_bound ts_i step valid]
show "valid_pimp (ts[i := (p', is @ is', θ, sb @ [Prog⇩s⇩b p p' is'], 𝒟, 𝒪,ℛ)])" .
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb 𝒮 m m' sb' 𝒪' ℛ' 𝒮'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,ℛ)"
and step: "(m, sb, 𝒪, ℛ,𝒮) →⇩f (m', sb',𝒪',ℛ',𝒮')"
and valid: "valid_pimp ts"
thm flush_step_preserves_valid [OF ]
from flush_step_preserves_valid [OF i_bound ts_i step valid]
show "valid_pimp (ts[i := (p, is, θ, sb', 𝒟, 𝒪',ℛ')])" .
next
fix i ts p "is" 𝒪 ℛ 𝒟 θ sb 𝒮 m is' 𝒪' ℛ' 𝒟' θ' sb' 𝒮' m'
assume i_bound: "i < length ts"
and ts_i: "ts ! i = (p, is, θ, sb::stmt_config store_buffer, 𝒟, 𝒪,ℛ)"
and step: "(is, θ, sb, m, 𝒟, 𝒪, ℛ, 𝒮) →⇩s⇩b⇩h
(is', θ', sb', m',𝒟', 𝒪', ℛ',𝒮')"
and valid: "valid_pimp ts"
from sbh_step_preserves_valid [OF i_bound ts_i step valid]
show "valid_pimp (ts[i := (p, is', θ', sb', 𝒟', 𝒪',ℛ')])" .
qed
thm PIMP.concurrent_direct_steps_simulates_store_buffer_history_step
thm PIMP.concurrent_direct_steps_simulates_store_buffer_history_steps
thm PIMP.concurrent_direct_steps_simulates_store_buffer_step
text ‹We can instantiate PIMP with the various memory models.›
interpretation direct:
computation direct_memop_step empty_storebuffer_step stmt_step "λp p' is sb. ()".
interpretation virtual:
computation virtual_memop_step empty_storebuffer_step stmt_step "λp p' is sb. ()".
interpretation store_buffer:
computation sb_memop_step store_buffer_step stmt_step "λp p' is sb. sb" .
interpretation store_buffer_history:
computation sbh_memop_step flush_step stmt_step "λp p' is sb. sb @ [Prog⇩s⇩b p p' is]".
abbreviation direct_pimp_step::
"(stmt_config,unit,bool,owns,rels,shared) global_config ⇒ (stmt_config,unit,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩d⇩p _" [60,60] 100)
where
"c ⇒⇩d⇩p d ≡ direct.concurrent_step c d"
abbreviation direct_pimp_steps::
"(stmt_config,unit,bool,owns,rels,shared) global_config ⇒ (stmt_config,unit,bool,owns,rels,shared) global_config ⇒ bool"
("_ ⇒⇩d⇩p⇧* _" [60,60] 100)
where
"direct_pimp_steps == direct_pimp_step^**"
text ‹Execution examples›
lemma Assign_Const_ex:
"([((Assign True (Tmp ({},λθ. a)) (Const c) (λθ. A) (λθ. L) (λθ. R) (λθ. W),t),[],θ,(),𝒟,𝒪,ℛ)],m,𝒮) ⇒⇩d⇩p⇧*
([((Skip,t),[],θ,(),True,𝒪 ∪ A - R,Map.empty)],m(a := c),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Program [where i=0])
apply simp
apply simp
apply (rule Assign)
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Memop [where i=0])
apply simp
apply simp
apply (rule direct_memop_step.WriteVolatile)
apply simp
done
lemma
" ([((Assign True (Tmp ({},λθ. a)) (Binop (+) (Mem True x) (Mem True y)) (λθ. A) (λθ. L) (λθ. R) (λθ. W),t),[],θ,(),𝒟,𝒪,ℛ)],m,S)
⇒⇩d⇩p⇧*
([((Skip,t + 2),[],θ(t↦m x, t + 1 ↦m y),(),True,𝒪 ∪ A - R,Map.empty)],m(a := m x + m y),S ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Program [where i=0])
apply simp
apply simp
apply (rule Assign)
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Memop)
apply simp
apply simp
apply (rule direct_memop_step.Read )
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Memop)
apply simp
apply simp
apply (rule direct_memop_step.Read)
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Memop)
apply simp
apply simp
apply (rule direct_memop_step.WriteVolatile )
apply simp
done
lemma
assumes isTrue: "isTrue c"
shows
"([((Cond (Const c) (Assign True (Tmp ({},λθ. a)) (Const c) (λθ. A) (λθ. L) (λθ. R) (λθ. W)) Skip,t) ,[],θ,(),𝒟,𝒪,ℛ)],m,𝒮) ⇒⇩d⇩p⇧*
([((Skip,t),[],θ,(),True,𝒪 ∪ A - R,Map.empty)],m(a := c),𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)"
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Program [where i=0])
apply simp
apply simp
apply (rule Cond)
apply simp
apply simp
apply (rule converse_rtranclp_into_rtranclp)
apply (rule direct.Program [where i=0])
apply simp
apply simp
apply (rule CondTrue)
apply simp
apply (simp add: isTrue)
apply simp
apply (rule Assign_Const_ex)
done
end
Theory SyntaxTweaks
theory SyntaxTweaks
imports Main
begin
syntax (implnl output)
"⟹" :: "prop ⇒ prop ⇒ prop" ("_ //⟹ _" [0,1] 1)
notation (holimplnl output)
"implies" ("(2_ ⟶// _)" [0,1] 1)
notation (holimplnl output)
"conj" ("_ ∧/ _" [34,35]35)
syntax (letnl output)
"_binds" :: "[letbind, letbinds] => letbinds" ("_;//_")
text ‹Theorems as inference rules, usepackage mathpartir›
syntax (eqindent output) "op =" ::"['a, 'a] => bool" ( "(2_ =/ _)" [49,50]50)
syntax (latex output)
If :: "[bool, 'a, 'a] => 'a"
("(\<^latex>‹\\holkeyword{›if\<^latex>‹}›(_)/ \<^latex>‹\\holkeyword{›then\<^latex>‹}› (_)/ \<^latex>‹\\holkeyword{›else\<^latex>‹}› (_))" 10)
"_Let" :: "[letbinds, 'a] => 'a"
("(\<^latex>‹\\holkeyword{›let\<^latex>‹}› (_)/ \<^latex>‹\\holkeyword{›in\<^latex>‹}› (_))" 10)
"_case_syntax":: "['a, cases_syn] => 'b"
("(\<^latex>‹\\holkeyword{›case\<^latex>‹}› _ \<^latex>‹\\holkeyword{›of\<^latex>‹}›/ _)" 10)
notation (Rule output)
Pure.imp ("\<^latex>‹\\mbox{}\\inferrule{\\mbox{›_\<^latex>‹}}›\<^latex>‹{\\mbox{›_\<^latex>‹}}›")
syntax (Rule output)
"_bigimpl" :: "asms ⇒ prop ⇒ prop"
("\<^latex>‹\\mbox{}\\inferrule{›_\<^latex>‹}›\<^latex>‹{\\mbox{›_\<^latex>‹}}›")
"_asms" :: "prop ⇒ asms ⇒ asms"
("\<^latex>‹\\mbox{›_\<^latex>‹}\\\\›/ _")
"_asm" :: "prop ⇒ asms" ("\<^latex>‹\\mbox{›_\<^latex>‹}›")
notation (Axiom output)
"Trueprop" ("\<^latex>‹\\mbox{}\\inferrule{\\mbox{}}{\\mbox{›_\<^latex>‹}}›")
syntax (IfThen output)
"==>" :: "prop ⇒ prop ⇒ prop"
("\<^latex>‹{\\normalsize{}›If\<^latex>‹\\,}› _/ \<^latex>‹{\\normalsize \\,›then\<^latex>‹\\,}›/ _.")
"_bigimpl" :: "asms ⇒ prop ⇒ prop"
("\<^latex>‹{\\normalsize{}›If\<^latex>‹\\,}› _ /\<^latex>‹{\\normalsize \\,›then\<^latex>‹\\,}›/ _.")
"_asms" :: "prop ⇒ asms ⇒ asms" ("\<^latex>‹\\mbox{›_\<^latex>‹}› /\<^latex>‹{\\normalsize \\,›and\<^latex>‹\\,}›/ _")
"_asm" :: "prop ⇒ asms" ("\<^latex>‹\\mbox{›_\<^latex>‹}›")
syntax (IfThenNoBox output)
"==>" :: "prop ⇒ prop ⇒ prop"
("\<^latex>‹{\\normalsize{}›If\<^latex>‹\\,}› _/ \<^latex>‹{\\normalsize \\,›then\<^latex>‹\\,}›/ _.")
"_bigimpl" :: "asms ⇒ prop ⇒ prop"
("\<^latex>‹{\\normalsize{}›If\<^latex>‹\\,}› _ /\<^latex>‹{\\normalsize \\,›then\<^latex>‹:\\,}›/ _.")
"_asms" :: "prop ⇒ asms ⇒ asms" ("_ /\<^latex>‹{\\normalsize \\,›and\<^latex>‹\\,}›/ _")
"_asm" :: "prop ⇒ asms" ("_")
text ‹power›
syntax (latex output)
power :: "['a::power, nat] => 'a" ("_⇗_⇖" [1000,0]80)
syntax (latex output)
"_emptyset" :: "'a set" ("∅")
translations
"_emptyset" <= "{}"
text ‹insert›
translations
"{x,y}" <= "{x} ∪ {y}"
"{x,y} ∪ A" <= "{x} ∪ ({y} ∪ A)"
"{x}" <= "{x} ∪ {}"
syntax (latex output)
Cons :: "'a ⇒ 'a list ⇒ 'a list" (infixr "⋅" 65)
syntax (latex output)
"Some" :: "'a ⇒ 'a option" ("(⌊_⌋)")
"None" :: "'a option" ("⊥")
text ‹lesser indentation as default›
syntax (latex output)
"ALL " :: "[idts, bool] => bool" ("(2∀_./ _)" [0, 10] 10)
"EX " :: "[idts, bool] => bool" ("(2∃_./ _)" [0, 10] 10)
text ‹space around ∈›
syntax (latex output)
"_Ball" :: "pttrn => 'a set => bool => bool" ("(3∀_\<^latex>‹\\,›∈_./ _)" [0, 0, 10] 10)
"_Bex" :: "pttrn => 'a set => bool => bool" ("(3∃_\<^latex>‹\\,›∈_./ _)" [0, 0, 10] 10)
text ‹compact line breaking for some infix operators›
term "HOL.conj"
notation (compact output)
"conj" ("_ ∧/ _" [34,35]35)
notation (compact output)
"append" ("_ @/ _" [64,65]65)
text ‹force a newline after definition equation›
syntax (defnl output)
"==" :: "[prop, prop] => prop" ("(2_ ≡// _)" [1,2] 2)
syntax (defeqnl output)
"==" :: "[prop, prop] => prop" ("(2_ =// _)" [1,2] 2)
syntax (eqnl output)
"op =" :: "['a, 'a] => bool" ("(2_ =// _)" [1,2] 2)
syntax (latex output)
"==" :: "[prop, prop] => prop" ("(2_ ≡/ _)" [1,2] 2)
text ‹New-line after assumptions›
syntax (asmnl output)
"_asms" :: "prop ⇒ asms ⇒ asms"
("_; // _")
text ‹uncurry functions›
syntax (uncurry output)
"_cargs" :: "'a ⇒ cargs ⇒ cargs" ("_, _")
"_applC" :: "[('b => 'a), cargs] => logic" ("(1_/(1'(_')))" [1000, 0] 1000)
text ‹but keep curried notation for constructors›
syntax (uncurry output)
"_cargs_curry":: "'a ⇒ cargs ⇒ cargs" ("_ _" [1000,1000] 1000)
"_applC_curry":: "[('b => 'a), cargs] => logic" ("(1_/ _)" [1000, 1000] 999)
text ‹`dot'-selector notation for records›
syntax (latex output)
"_rec_sel" :: "'r ⇒ id ⇒ 'a" ("_._" [1000,1000]1000)
ML ‹
structure Latex =
struct
open Latex;
fun latex_markup (s, props: Properties.T) =
if s = Markup.commandN orelse s = Markup.keyword1N orelse s = Markup.keyword3N
then ("\\isacommand{", "}")
else if s = Markup.keyword2N
then ("\\isakeyword{", "}")
else Markup.no_output;
end;
fun latex_markup (s, props) =
if s = Markup.boundN orelse s = Markup.freeN orelse s = Markup.varN orelse s = Markup.tfreeN orelse s = Markup.tvarN
then ("\\" ^ s ^ "ify{", "}")
else Latex.latex_markup (s, props);
val _ = Markup.add_mode Latex.latexN latex_markup;
›
text ‹invisible binder in case we want to force "bound"-markup›
consts Bind:: "('a ⇒ 'b) ⇒ 'c" (binder "Bind " 10)
translations
"f" <= "Bind x. f"
notation (latex output)
length ("|_|")
notation (latex output)
None ("⊥")
notation (latex output)
Some ("⌊_⌋")
notation (latex output)
nth ("_\<^latex>‹\\ensuremath{_{[›_\<^latex>‹]}}›" [1000,0] 1000)
end
Theory Abbrevs
theory Abbrevs
imports PIMP SyntaxTweaks
begin
text ‹now we can use dots as a term›
consts dots::"'a" ("…")
lemma conj_to_impl: "(P ∧ Q ⟶ R) = (P ⟶ Q ⟶ R)"
by auto
notation (in xvalid_program) (latex output)
barrier_inv ("flush'_inv")
abbreviation
"acquire sb owns ≡ acquired True sb owns"
notation (latex output)
direct_memop_step ("_ \<^latex>‹$\\overset{\\isa{v}_\\isa{d}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)
notation (latex output)
virtual_memop_step ("_ \<^latex>‹$\\overset{\\isa{v}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)
context program
begin
term "(ts, m) ⇒⇩s⇩b (ts',m')"
notation (latex output) store_buffer.concurrent_step ("_ \<^latex>‹$\\overset{\\isa{sb}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output) virtual.concurrent_step ("_ \<^latex>‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)
thm store_buffer.concurrent_step.Program
end
abbreviation (output)
"sbh_global_step ≡ computation.concurrent_step sbh_memop_step flush_step stmt_step (λp p' is sb. sb @ [Prog⇩s⇩b p p' is])"
notation (latex output)
sbh_global_step ("_ \<^latex>‹$\\overset{\\isa{sbh}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
direct_pimp_step ("_ \<^latex>‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
sbh_memop_step ("_ \<^latex>‹$\\overset{\\isa{sbh}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)
notation (latex output)
sb_memop_step ("_ \<^latex>‹$\\overset{\\isa{sb}}{\\rightarrow}_{\\isa{m}}$› _" [60,60] 100)
notation (output)
sim_direct_config ("_ ∼ _ " [60,60] 100)
notation (output)
flush_step ("_ →⇩s⇩b⇩h _" [60,60] 100)
notation (output)
store_buffer_step ("_ →⇩s⇩b _" [60,60] 100)
notation (output)
outstanding_refs ("refs")
notation (output)
is_volatile_Write⇩s⇩b ("volatile'_Write")
abbreviation (output)
"not_volatile_write ≡ Not ∘ is_volatile_Write⇩s⇩b"
notation (output)
"flush_all_until_volatile_write" ("exec'_all'_until'_volatile'_write")
notation (output)
"share_all_until_volatile_write" ("share'_all'_until'_volatile'_write")
notation (output)
stmt_step ("_⊢ _ →⇩p _" [60,60,60] 100)
notation (output)
augment_rels ("aug")
context program
begin
notation (latex output)
direct_concurrent_step ("_ \<^latex>‹$\\overset{\\isa{v}_\\isa{d}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
direct_concurrent_steps ("_ \<^latex>‹$\\overset{\\isa{v}_\\isa{d}}{\\Rightarrow}^{*}$› _" [60,60] 100)
notation (latex output)
sbh_concurrent_step ("_ \<^latex>‹$\\overset{\\isa{sbh}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
sbh_concurrent_steps ("_ \<^latex>‹$\\overset{\\isa{sbh}}{\\Rightarrow}^{*}$› _" [60,60] 100)
notation (latex output)
sb_concurrent_step ("_ \<^latex>‹$\\overset{\\isa{sb}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
sb_concurrent_steps ("_ \<^latex>‹$\\overset{\\isa{sb}}{\\Rightarrow}^{*}$› _" [60,60] 100)
notation (latex output)
virtual_concurrent_step ("_ \<^latex>‹$\\overset{\\isa{v}}{\\Rightarrow}$› _" [60,60] 100)
notation (latex output)
virtual_concurrent_steps ("_ \<^latex>‹$\\overset{\\isa{v}}{\\Rightarrow}^{*}$› _" [60,60] 100)
end
context xvalid_program_progress
begin
abbreviation
"safe_reach_virtual_free_flowing ≡ safe_reach virtual_concurrent_step safe_free_flowing"
notation (latex output)
"safe_reach_virtual_free_flowing" ("safe'_reach")
abbreviation
"safe_reach_direct_delayed ≡ safe_reach direct_concurrent_step safe_delayed"
notation (latex output)
"safe_reach_direct_delayed" ("safe'_reach'_delayed")
end
translations
"x" <= "(x,())"
"x" <= "((),x)"
translations
"CONST initial⇩v xs ys" <= "CONST initial⇩v xs ys zs"
end
Theory Variants
theory Variants
imports Abbrevs
begin
lemma restrict_map_inverse: "m |` (dom m - X) = m |`(-X)"
apply (rule ext)
apply (auto simp add: restrict_map_def)
done
lemma conj_assoc: "((P ∧ Q) ∧ X) = (P ∧ Q ∧ X)"
by simp
notation (latex output)
Read ("\<^latex>‹\\constructor{Read}›")
notation (latex output)
Write ("\<^latex>‹\\constructor{Write}›")
notation (latex output)
RMW ("\<^latex>‹\\constructor{RMW}›")
notation (latex output)
Fence ("\<^latex>‹\\constructor{Fence}›")
notation (latex output)
Ghost ("\<^latex>‹\\constructor{Ghost}›")
notation (latex output)
Write⇩s⇩b ("\<^latex>‹\\constructor{Write}›⇩s⇩b")
notation (latex output)
Read⇩s⇩b ("\<^latex>‹\\constructor{Read}›⇩s⇩b")
notation (latex output)
Prog⇩s⇩b ("\<^latex>‹\\constructor{Prog}›⇩s⇩b")
notation (latex output)
Ghost⇩s⇩b ("\<^latex>‹\\constructor{Ghost}›⇩s⇩b")
notation (latex output)
Const ("\<^latex>‹\\constructor{Const}›")
notation (latex output)
Mem ("\<^latex>‹\\constructor{Mem}›")
notation (latex output)
Tmp ("\<^latex>‹\\constructor{Tmp}›")
notation (latex output)
Unop ("\<^latex>‹\\constructor{Unop}›")
notation (latex output)
Binop ("\<^latex>‹\\constructor{Binop}›")
notation (latex output)
Skip ("\<^latex>‹\\constructor{Skip}›")
notation (latex output)
Assign ("\<^latex>‹\\constructor{Assign}›")
notation (latex output)
CAS ("\<^latex>‹\\constructor{CAS}›")
notation (latex output)
Seq ("\<^latex>‹\\constructor{Seq}›")
notation (latex output)
Cond ("\<^latex>‹\\constructor{Cond}›")
notation (latex output)
While ("\<^latex>‹\\constructor{While}›")
notation (latex output)
SGhost ("\<^latex>‹\\constructor{SGhost}›")
notation (latex output)
SFence ("\<^latex>‹\\constructor{SFence}›")
lemma sim_direct_config_def': "ts⇩s⇩b ∼⇩d ts ≡
(ts⇩s⇩b = (map (λ(p,is, θ,sb::unit,𝒟, 𝒪,ℛ). (p,is,θ,[],(),(),())) ts))"
apply (rule HOL.eq_reflection)
apply rule
apply (erule sim_direct_config.cases)
apply (clarsimp)
apply (rule nth_equalityI)
apply simp
apply clarsimp
apply (case_tac "ts!i")
apply fastforce
apply (rule sim_direct_config.intros)
apply auto
done
ML ‹@{term "(λ(p,is, θ,sb::unit,𝒟, 𝒪,ℛ). (p,is,θ,[],(),(),()))"}›
lemma DRead: "(Read volatile a t # is,θ, x, m,ghst) →
(is, θ (t↦m a), x, m, ghst)"
apply (cases ghst)
apply (simp add: direct_memop_step.Read)
done
lemma DWriteNonVolatile:"
(Write False a (D,f) A L R W#is, θ, x, m, ghst) → (is, θ, x, m(a := f θ), ghst)"
apply (cases ghst)
apply (simp add: direct_memop_step.WriteNonVolatile)
done
lemma DWriteVolatile:
"ghst = (𝒟, 𝒪, ℛ, 𝒮) ⟹ ghst' = (True, 𝒪 ∪ A - R, Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
⟹ (Write True a (D,f) A L R W# is, θ, x, m, ghst) → (is, θ, x, m(a:=f θ), ghst')"
by (simp add: direct_memop_step.WriteVolatile)
lemma DGhost:
"ghst = (𝒟, 𝒪, ℛ, 𝒮) ⟹ ghst' = (𝒟, 𝒪 ∪ A - R, augment_rels (dom 𝒮) R ℛ, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
⟹ (Ghost A L R W# is, θ, x, m, ghst) → (is, θ, x, m, ghst')"
by (simp add: direct_memop_step.Ghost)
lemma DRMWReadOnly:
"⟦¬ cond (θ(t↦m a)); ghst = (𝒟, 𝒪, ℛ, 𝒮); ghst'=(False, 𝒪, Map.empty,𝒮)⟧ ⟹
(RMW a t (D,f) cond ret A L R W # is, θ, x, m, ghst) → (is, θ(t↦m a),x,m, ghst')"
apply (simp add: direct_memop_step.RMWReadOnly)
done
lemma DRMWWrite:
"⟦cond (θ(t↦m a));
θ' = θ(t↦ret (m a) (f(θ(t↦m a))));
m' = m(a:= f(θ(t↦m a)));
ghst = (𝒟, 𝒪, ℛ, 𝒮);
ghst' = (False,𝒪 ∪ A - R, Map.empty, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)⟧
⟹
(RMW a t (D,f) cond ret A L R W# is, θ, x, m, ghst) → (is, θ',x, m' , ghst')"
apply (simp add: direct_memop_step.RMWWrite)
done
lemma VRead: "(Read volatile a t # is,θ, x, m,ghst) →⇩v
(is, θ (t↦m a), x, m, ghst)"
apply (cases ghst)
apply (simp add: virtual_memop_step.Read)
done
lemma VWriteNonVolatile:"
(Write False a (D,f) A L R W#is, θ, x, m, ghst) →⇩v (is, θ, x, m(a := f θ), ghst)"
apply (cases ghst)
apply (simp add: virtual_memop_step.WriteNonVolatile)
done
lemma VWriteVolatile:
"ghst = (𝒟, 𝒪, ℛ, 𝒮) ⟹ ghst' = (True, 𝒪 ∪ A - R, ℛ, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
⟹ (Write True a (D,f) A L R W# is, θ, x, m, ghst) →⇩v (is, θ, x, m(a:=f θ), ghst')"
by (simp add: virtual_memop_step.WriteVolatile)
lemma VRMWReadOnly:
"⟦¬ cond (θ(t↦m a)); ghst = (𝒟, 𝒪, ℛ, 𝒮); ghst'=(False, 𝒪,ℛ,𝒮)⟧ ⟹
(RMW a t (D,f) cond ret A L R W # is, θ, x, m, ghst) →⇩v (is, θ(t↦m a),x,m, ghst')"
apply (simp add: virtual_memop_step.RMWReadOnly)
done
lemma VFence:
"ghst = (𝒟, 𝒪, ℛ, 𝒮) ⟹ ghst' = (False, 𝒪, ℛ, 𝒮)
⟹ (Fence# is, θ, x, m, ghst) →⇩v (is, θ, x, m, ghst')"
by (simp add: virtual_memop_step.Fence)
lemma VGhost:
"ghst = (𝒟, 𝒪, ℛ, 𝒮) ⟹ ghst' = (𝒟, 𝒪 ∪ A - R, ℛ, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)
⟹ (Ghost A L R W# is, θ, x, m, ghst) →⇩v (is, θ, x, m, ghst')"
by (simp add: virtual_memop_step.Ghost)
lemma VRMWWrite:
"⟦cond (θ(t↦m a));
θ' = θ(t↦ret (m a) (f(θ(t↦m a))));
m' = m(a:= f(θ(t↦m a)));
ghst = (𝒟, 𝒪, ℛ, 𝒮);
ghst' = (False,𝒪 ∪ A - R, ℛ, 𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)⟧
⟹
(RMW a t (D,f) cond ret A L R W# is, θ, x, m, ghst) →⇩v (is, θ',x, m' , ghst')"
apply (simp add: virtual_memop_step.RMWWrite)
done
lemma SafeWriteVolatile:
"⟦∀j < length 𝒪s. i≠j ⟶ a ∉ 𝒪s!j; a ∉ read_only 𝒮;
∀j < length 𝒪s. i≠j ⟶ A ∩ 𝒪s!j = {};
A ⊆ 𝒪 ∪ dom 𝒮; L ⊆ A; R ⊆ 𝒪; A ∩ R = {}
⟧
⟹
𝒪s,i⊢(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_direct_memop_state.WriteVolatile)
apply auto
done
lemma SafeDelayedWriteVolatile:
"⟦∀j < length 𝒪s. i≠j ⟶ a ∉ (𝒪s!j ∪ dom (ℛs!j)); a ∉ read_only 𝒮;
∀j < length 𝒪s. i≠j ⟶ A ∩ (𝒪s!j ∪ dom (ℛs!j)) = {};
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {}
⟧
⟹
𝒪s,ℛs,i⊢(Write True a (D,f) A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_delayed_direct_memop_state.WriteVolatile)
apply auto
done
lemma SafeRMWReadOnly:
"⟦¬ cond (θ(t↦m a)); a ∈ dom 𝒮 ∪ 𝒪⟧ ⟹
𝒪s,i⊢ (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_direct_memop_state.RMWReadOnly)
apply auto
done
lemma SafeDelayedRMWReadOnly:
"⟦¬ cond (θ(t↦m a)); a ∈ dom 𝒮 ∪ 𝒪;
∀j < length 𝒪s. i≠j ⟶ (ℛs!j) a ≠ Some False ⟧
⟹
𝒪s,ℛs,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_delayed_direct_memop_state.RMWReadOnly)
apply auto
done
lemma SafeRMWWrite:
"⟦cond (θ(t↦m a));
∀j < length 𝒪s. i≠j ⟶ a ∉ 𝒪s!j; a ∉ read_only 𝒮;
∀j < length 𝒪s. i≠j ⟶ A ∩ 𝒪s!j = {};
A ⊆ 𝒪 ∪ dom 𝒮; L ⊆ A; R ⊆ 𝒪; A ∩ R = {}
⟧
⟹
𝒪s,i⊢ (RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_direct_memop_state.RMWWrite)
apply auto
done
lemma SafeDelayedRMWWrite:
"⟦cond (θ(t↦m a)); a ∈ dom 𝒮 ∪ 𝒪;
∀j < length 𝒪s. i≠j ⟶ a ∉ (𝒪s!j ∪ dom (ℛs!j));a ∉ read_only 𝒮;
∀j < length 𝒪s. i≠j ⟶ A ∩ (𝒪s!j ∪ dom (ℛs!j)) = {};
A ⊆ dom 𝒮 ∪ 𝒪; L ⊆ A; R ⊆ 𝒪; A ∩ R = {}
⟧
⟹
𝒪s,ℛs,i⊢(RMW a t (D,f) cond ret A L R W# is, θ, m, 𝒟, 𝒪, 𝒮)√"
apply (rule safe_delayed_direct_memop_state.RMWWrite)
apply auto
done
lemma Write⇩s⇩bNonVolatile:
"(m, Write⇩s⇩b False a sop v A L R W# rs,𝒪,ℛ,𝒮) →⇩f (m(a := v), rs,𝒪,ℛ,𝒮)"
apply (rule flush_step.Write⇩s⇩b)
apply auto
done
lemma Write⇩s⇩bVolatile:
"⟦𝒪'= 𝒪 ∪ A - R; 𝒮'=(𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)⟧ ⟹
(m, Write⇩s⇩b True a sop v A L R W# rs,𝒪,ℛ,𝒮) →⇩f (m(a := v), rs,𝒪',Map.empty,𝒮')"
apply (rule flush_step.Write⇩s⇩b)
apply auto
done
lemma Ghost⇩s⇩b: "⟦𝒪'= 𝒪 ∪ A - R; ℛ'= augment_rels (dom 𝒮) R ℛ; 𝒮'=𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L⟧ ⟹
(m, Ghost⇩s⇩b A L R W# rs,𝒪,ℛ,𝒮) →⇩f (m, rs,𝒪',ℛ',𝒮')"
by (simp add: flush_step.Ghost)
lemma SBHRead:
"⟦v = (case (buffered_val sb a) of Some v' ⇒ v' | None ⇒ m a);
sb' = sb@[Read⇩s⇩b volatile a t v] ⟧
⟹
(Read volatile a t # is, θ, sb, m,ghst) →⇩s⇩b⇩h
(is, θ (t↦v), sb', m,ghst)"
apply (cases ghst)
apply (cases "buffered_val sb a")
apply (auto simp add: SBHReadBuffered SBHReadUnbuffered)
done
lemma SBRead:
"⟦v = (case (buffered_val sb a) of Some v' ⇒ v' | None ⇒ m a)⟧
⟹
(Read volatile a t # is, θ, sb, m,ghst) →⇩s⇩b
(is, θ (t↦v), sb, m,ghst)"
apply (cases ghst)
apply (cases "buffered_val sb a")
apply (auto simp add: SBReadBuffered SBReadUnbuffered)
done
lemma SBHReadBuffered':
"⟦buffered_val sb a = Some v;
sb' = sb@[Read⇩s⇩b volatile a t v] ⟧
⟹
(Read volatile a t # is, θ, sb, m, 𝒟, 𝒪,ℛ, 𝒮) →⇩s⇩b⇩h
(is, θ (t↦v), sb', m, 𝒟, 𝒪,ℛ, 𝒮)"
by (simp add: SBHReadBuffered)
lemma SBHReadUnbuffered':
"⟦buffered_val sb a = None;
sb' = sb@[Read⇩s⇩b volatile a t (m a)]⟧
⟹
(Read volatile a t # is,θ, sb, m, 𝒟, 𝒪,ℛ, 𝒮) →⇩s⇩b⇩h
(is,θ (t↦m a), sb', m, 𝒟, 𝒪,ℛ, 𝒮)"
by (simp add: SBHReadUnbuffered)
lemma SBHWriteNonVolatile':
"⟦ sb'= sb@ [Write⇩s⇩b False a (D,f) (f θ) A L R W]⟧
⟹
(Write False a (D,f) A L R W#is,θ, sb, m, ghst) →⇩s⇩b⇩h
(is, θ, sb', m, ghst)"
by (cases ghst) (simp add: SBHWriteNonVolatile)
lemma SBWriteNonVolatile':
"⟦ sb'= sb@ [Write⇩s⇩b False a (D,f) (f θ) A L R W]⟧
⟹
(Write False a (D,f) A L R W#is,θ, sb, m, ghst) →⇩s⇩b
(is, θ, sb', m, ghst)"
by (cases ghst) (simp add: SBWriteNonVolatile)
lemma SBHWriteVolatile':
"⟦sb'= sb@[Write⇩s⇩b True a (D,f) (f θ) A L R W]; ghst = (𝒟, 𝒪, ℛ, 𝒮); ghst' = (True, 𝒪,ℛ, 𝒮)⟧
⟹
(Write True a (D,f) A L R W# is,θ, sb, m,ghst) →⇩s⇩b⇩h
(is,θ, sb', m,ghst')"
by (simp add: SBHWriteVolatile)
lemma SBHGhost':
"(Ghost A L R W# is, θ, sb, m, G) →⇩s⇩b⇩h
(is, θ, sb@[Ghost⇩s⇩b A L R W], m, G)"
by (cases G) (simp add: SBHGhost)
lemma SBWriteVolatile':
"⟦sb'= sb@[Write⇩s⇩b True a (D,f) (f θ) A L R W]⟧
⟹
(Write True a (D,f) A L R W# is,θ, sb, m,ghst) →⇩s⇩b
(is,θ, sb', m,ghst)"
by (cases ghst) (simp add: SBWriteVolatile)
lemma SBWrite':
"⟦sb'= sb@[Write⇩s⇩b volatile a (D,f) (f θ) A L R W]⟧
⟹
(Write volatile a (D,f) A L R W# is,θ, sb, m,ghst) →⇩s⇩b
(is,θ, sb', m,ghst)"
apply (cases volatile)
apply (auto intro: SBWriteVolatile' SBWriteNonVolatile')
done
lemma SBHRMWReadOnly':
"⟦¬ cond (θ(t↦m a)); ghst = (𝒟, 𝒪, ℛ, 𝒮); ghst' = (False, 𝒪, Map.empty,𝒮)⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) →⇩s⇩b⇩h (is, θ(t↦m a),[], m, ghst')"
by (simp add: SBHRMWReadOnly)
lemma SBHRMWWrite':
"⟦cond (θ(t↦m a)); θ'=θ(t↦ret (m a) (f(θ(t↦m a))));m'=m(a:= f(θ(t↦m a)));
ghst = (𝒟, 𝒪,ℛ, 𝒮); ghst'=(False, 𝒪 ∪ A - R, Map.empty,𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L)⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) →⇩s⇩b⇩h
(is, θ',[], m', ghst')"
by (simp add: SBHRMWWrite)
lemma SBRMWReadOnly':
"⟦¬ cond (θ(t↦m a)); θ'=θ(t↦m a)⟧ ⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) →⇩s⇩b (is, θ',[], m, ghst)"
by (cases ghst) (simp add: SBRMWReadOnly)
lemma SBRMWWrite':
"⟦cond (θ(t↦m a)); θ'=θ(t↦ret (m a) (f(θ(t↦m a))));m'=m(a:= f(θ(t↦m a)))⟧
⟹
(RMW a t (D,f) cond ret A L R W# is, θ, [], m, ghst) →⇩s⇩b
(is, θ',[], m', ghst)"
by (cases ghst) (simp add: SBRMWWrite)
lemma sim_config':
"⟦m = flush_all_until_volatile_write ts⇩s⇩b⇩h m⇩s⇩b⇩h;
𝒮 = share_all_until_volatile_write ts⇩s⇩b⇩h 𝒮⇩s⇩b⇩h;
length ts⇩s⇩b⇩h = length ts;
∀i < length ts⇩s⇩b⇩h.
let (p⇩s⇩b⇩h, is⇩s⇩b⇩h, θ⇩s⇩b⇩h, sb, 𝒟⇩s⇩b⇩h, 𝒪⇩s⇩b⇩h,ℛ⇩s⇩b⇩h) = ts⇩s⇩b⇩h!i;
execs = takeWhile (Not ∘ is_volatile_Write⇩s⇩b) sb;
suspends = dropWhile (Not ∘ is_volatile_Write⇩s⇩b) sb
in ∃is 𝒟. instrs suspends @ is⇩s⇩b⇩h = is @ prog_instrs suspends ∧
𝒟⇩s⇩b⇩h = (𝒟 ∨ outstanding_refs is_volatile_Write⇩s⇩b sb ≠ {}) ∧
ts!i = (hd_prog p⇩s⇩b⇩h suspends,
is,
θ⇩s⇩b⇩h |` (dom θ⇩s⇩b⇩h - read_tmps suspends),(),
𝒟,
acquired True execs 𝒪⇩s⇩b⇩h,
release execs (dom 𝒮⇩s⇩b⇩h) ℛ⇩s⇩b⇩h)
⟧
⟹
(ts⇩s⇩b⇩h,m⇩s⇩b⇩h,𝒮⇩s⇩b⇩h) ∼ (ts,m,𝒮)"
apply (rule sim_config.intros)
apply (simp_all add: Let_def)
done
lemma AssignAddr':
"⟦∀sop. a ≠ Tmp sop; a'=Tmp (eval_expr t a); t'= t + used_tmps a; is=issue_expr t a ⟧ ⟹
θ⊢ (Assign volatile a e A L R W, t) →⇩s
((Assign volatile a' e A L R W, t'),is)"
by (simp add: AssignAddr)
lemma Assign':
"⟦D ⊆ dom θ; is= issue_expr t e@[Write volatile (a θ) (eval_expr t e) (A θ) (L θ) (R θ) (W θ)]⟧ ⟹
θ⊢ (Assign volatile (Tmp (D,a)) e A L R W, t) →⇩s
((Skip, t + used_tmps e), is)"
by (simp add: Assign)
lemma CASAddr':
"⟦∀sop. a ≠ Tmp sop; a'=(Tmp (eval_expr t a));t'=t + used_tmps a; is=issue_expr t a ⟧ ⟹
θ⊢ (CAS a c⇩e s⇩e A L R W, t) →⇩s
((CAS a' c⇩e s⇩e A L R W, t'), is)"
by (simp add: CASAddr)
lemma CASComp':
"⟦∀sop. c⇩e ≠ Tmp sop;c⇩e'=(Tmp (eval_expr t c⇩e));t'=t + used_tmps c⇩e; is= issue_expr t c⇩e ⟧ ⟹
θ⊢ (CAS (Tmp a) c⇩e s⇩e A L R W, t) →⇩s
((CAS (Tmp a) c⇩e' s⇩e A L R W, t'), is)"
by (cases a) (simp add: CASComp)
lemma CAS':
"⟦D⇩a ⊆ dom θ; D⇩c ⊆ dom θ; eval_expr t s⇩e = (D,f);t'=(t + used_tmps s⇩e);
cond = (λθ. the (θ t') = c θ);
ret = (λv⇩1 v⇩2. v⇩1);
is = issue_expr t s⇩e@
[RMW (a θ) t' (D,f) cond ret
(A θ) (L θ) (R θ) (W θ) ]⟧
⟹
θ⊢ (CAS (Tmp (D⇩a,a)) (Tmp (D⇩c,c)) s⇩e A L R W, t) →⇩s
((Skip, Suc t'),is )"
by (simp add: CAS)
lemma SCond':
"∀sop. e ≠ Tmp sop ⟹ e'= (Tmp (eval_expr t e)) ⟹ t'=t + used_tmps e ⟹ is=issue_expr t e
⟹
θ⊢ (Cond e s⇩1 s⇩2, t) →⇩s
((Cond e' s⇩1 s⇩2, t'), is)"
by (simp add: Cond)
lemma SWhile':
"s'= (Cond e (Seq s (While e s)) Skip) ⟹
θ⊢ (While e s, t) →⇩s ((s', t),[])"
by (simp add: stmt_step.While)
theorem (in xvalid_program) simulation_hol:
"(ts⇩s⇩b⇩h,m⇩s⇩b⇩h,𝒮⇩s⇩b⇩h) ⇒⇩s⇩b⇩h (ts⇩s⇩b⇩h',m⇩s⇩b⇩h',𝒮⇩s⇩b⇩h') ∧
(ts⇩s⇩b⇩h,m⇩s⇩b⇩h,𝒮⇩s⇩b⇩h) ∼ (ts,m,𝒮) ∧ safe_reach_direct safe_delayed (ts, m, 𝒮) ∧
invariant ts⇩s⇩b⇩h 𝒮⇩s⇩b⇩h m⇩s⇩b⇩h ⟶
invariant ts⇩s⇩b⇩h' 𝒮⇩s⇩b⇩h' m⇩s⇩b⇩h' ∧
(∃ts' 𝒮' m'. (ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮') ∧ (ts⇩s⇩b⇩h',m⇩s⇩b⇩h',𝒮⇩s⇩b⇩h') ∼ (ts',m',𝒮'))"
apply clarify
apply (drule simulation')
by auto
theorem (in xvalid_program_progress) store_buffer_execution_result_sequential_consistent'_hol:
"(ts⇩s⇩b,m,x) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m',x') ∧
empty_store_buffers ts⇩s⇩b' ∧
ts⇩s⇩b ∼⇩d ts ∧
initial⇩v ts 𝒮 valid ∧
safe_reach_virtual safe_free_flowing (ts,m,𝒮)
⟶
(∃ts' 𝒮'.
(ts,m,𝒮) ⇒⇩v⇧* (ts',m',𝒮') ∧ ts⇩s⇩b' ∼⇩d ts')"
apply clarify
apply (drule store_buffer_execution_result_sequential_consistent')
apply auto
done
end
Theory Text
theory Text
imports Variants
begin
section ‹Programming discipline \label{sec:discipline}›
text ‹
For sequential code on a single processor the store buffer is invisible, since reads respect outstanding writes in the buffer.
This argument can be extended to thread local memory in the context of a multiprocessor architecture.
Memory typically becomes temporarily thread local by means of locking.
The C-idiom to identify shared portions of the memory is the \texttt{volatile}
tag on variables and type declarations.
Thread local memory can be accessed non-volatilely, whereas accesses to shared memory are tagged as volatile.
This prevents the compiler from applying certain optimizations to those accesses which could cause undesired behavior, \eg to store intermediate values in registers instead of writing them to the memory.
The basic idea behind the programming discipline is, that before gathering new information about the shared state (via reading) the thread has to make its outstanding changes to the shared state visible to others (by flushing the store buffer).
This allows to sequentialize the reads and writes to obtain a sequentially consistent execution of the global system.
In this sequentialization a write to shared memory happens when the write instruction exits the store buffer, and a read from the shared memory happens when all preceding writes have exited.
We distinguish thread local and shared memory by an ownership model.
Ownership is maintained in ghost state and can be transferred as side effect of write operations and by a dedicated ghost operation.
Every thread has a set of owned addresses. Owned addresses of different threads are disjoint.
Moreover, there is a global set of shared addresses which can additionally be marked as read-only.
Unowned addresses --- addresses owned by no thread --- can be accessed concurrently by all threads. They are a subset of the shared addresses. The read-only addresses are a subset of the unowned addresses (and thus of the shared addresses).
We only allow a thread to write to owned addresses and unowned, read-write addresses.
We only allow a thread to read from owned addresses and from shared addresses (even if they are owned by another thread).
All writes to shared memory have to be volatile. Reads from shared addresses also have to be volatile, except if the address is owned (\ie single writer, multiple readers) or if the address is read-only. Moreover, non-volatile writes are restricted to owned, unshared memory.
As long as a thread owns an address it is guaranteed that it is the only one writing to that address. Hence this thread can safely perform non-volatile reads to that address without missing any write. Similar it is safe for any thread to access read-only memory via non-volatile reads since there are no outstanding writes at all.
Recall that a volatile read is \Def{clean} if it is guaranteed that there is no outstanding volatile write (to any address) in the store buffer. Moreover every non-volatile read is clean.
To regain sequential consistency under the presence of store buffers every thread has to make sure that every read is clean, by flushing the store buffer when necessary. To check the flushing policy of a thread, we keep track of clean reads by means of ghost state. For every thread we maintain a dirty flag. It is reset as the store buffer gets flushed. Upon a volatile write the dirty flag is set. The dirty flag is considered to guarantee that a volatile read is clean.
Table \ref{tab:access-grid} summarizes the access policy and Table \ref{tab:flushing} the associated flushing policy of the programming discipline.
The key motivation is to improve performance by minimizing the number of store buffer flushes,
while staying sequentially consistent.
The need for flushing the store buffer decreases from interlocked accesses (where flushing is a side-effect) over volatile accesses to non-volatile accesses. From the viewpoint of access rights there is no difference between interlocked and volatile accesses. However, keep in mind that some interlocked operations can read from, modify and write to an address in a single atomic step of the underlying hardware and are typically used in lock-free algorithms or for the implementation of locks.
\begin{table}
\centering
\caption{Programming discipline.}
\captionsetup[table]{position=top}
\captionsetup[subtable]{position=top}
\newcommand{\mycomment}[1]{}
\subfloat[Access policy\label{tab:access-grid}]{
\begin{tabular}{m{1.2cm}@ {\hspace{2mm}}m{1.7cm}@ {\hspace{3mm}}m{1.8cm}m{2.2 cm}}
\toprule
& shared & shared & unshared \\
& (read-write) & (read-only) & \\
\midrule
unowned & \mycomment{iRW, iR, iW,} vR, vW & \mycomment{iR,} vR, R & unreachable\\
owned & \mycomment{iRW, iR, iW,} vR, vW, R & unreachable & \mycomment{iRW, iR, iW,} vR, vW, R, W \\
owned \mbox{by other} & \mycomment{iR,} vR & unreachable & \\
\bottomrule
\multicolumn{4}{l}{(v)olatile, (R)ead, (W)rite}\\
\multicolumn{4}{l}{all reads have to be clean }
\end{tabular}
%\caption{Access policy \label{tab:access-grid}}
}\hspace{0.3cm}
%
%\end{table}
%
%\begin{table}
%
\subfloat[Flushing policy\label{tab:flushing}]{
\begin{tabular}{lc}
\toprule
& flush (before) \\
\midrule
interlocked & as side effect \\
vR & if not clean \\
R, vW, W & never \\
\bottomrule
\end{tabular}
%\caption{Flushing policy \label{tab:flushing}}
}
\end{table}
›
section ‹Formalization \label{sec:formalization}›
text ‹
In this section we go into the details of our formalization. In our model, we distinguish the plain `memory system' from the
`programming language semantics' which we both describe as a small-step transition relation.
During a computation the programming language issues memory instructions (read / write) to the memory system,
which itself returns the results in temporary registers.
This clean interface allows us to parameterize the program semantics over the
memory system. Our main theorem allows us to simulate a computation step in the semantics based on a
memory system with store buffers by @{term "n"} steps in the semantics based on a
sequentially consistent memory system.
We refer to the former one as \Def{store buffer machine} and to the latter one as \Def{virtual machine}. The simulation theorem is independent of the programming language.
We continue with introducing the common parts of both machines.
In Section \ref{sec:storebuffermachine} we describe the store buffer machine and in Section \ref{sec:virtualmachine} we then describe the virtual machine. The main reduction theorem is presented in \ref{sec:reduction}.
\medskip
Addresses @{term "a"}, values @{term "v"} and temporaries @{term "t"} are natural numbers.
Ghost annotations for manipulating the ownership information are the following sets of addresses: the acquired addresses @{term "A"}, the unshared (local) fraction @{term "L"} of the acquired addresses, the released addresses @{term "R"} and the writable fraction @{term "W"} of the released addresses (the remaining addresses are considered read-only).
These ownership annotations are considered as side-effects on volatile writes and interlocked operations (in case a write is performed).
Moreover, a special ghost instruction allows to transfer ownership.
The possible status changes of an address due to these ownership transfer operations are depicted in Figure \ref{fig:ownership-transfer}. Note that ownership of an address is not directly transferred between threads, but is first released by one thread and then can be acquired by another thread.
%
\begin{figure}
\begin{center}
\begin{tikzpicture}
[auto,
outernode/.style = {rectangle, rounded corners, draw, text centered, minimum height=3cm, minimum width=2.7cm, fill=gray!20},
innernode/.style = {rectangle, rounded corners, draw, text centered, minimum height=1cm, minimum width=1cm, text width=1.5cm, fill=white}
]
\node[outernode] (owned) {};
\node[innernode] (oshared) [below] at ($ (owned.north) -(0,0.2cm) $) {shared read-write};
\node[innernode] (onshared) [above] at ($ (owned.south) +(0,0.2cm) $) {unshared};
\node[above] at (owned.north) {owned};
\node[outernode] (unowned) [right] at ($ (owned.east) +(1.5cm,0cm) $) {};
\node[innernode] (rwshared) [below] at ($ (unowned.north) -(0,0.2cm) $) {shared read-write};
\node[innernode] (roshared) [above] at ($ (unowned.south) +(0,0.2cm) $) {shared read-only};
\node[above] at (unowned.north) {unowned};
\path (rwshared.east) -- coordinate (middlex) (oshared.west);
\draw[->] (owned.east |- rwshared.170) -- (rwshared.170);
\node [above] at (rwshared.170 -| middlex) {@{term "R ∩ W"}};
\draw[->] (unowned.west |- oshared.350) -- (oshared.350);
\node [below] at (oshared.350 -| middlex) {@{term "A ∩ - L"}};
\draw[->] (unowned.west |- onshared.350) -- (onshared.350);
\node [below] at (onshared.350 -| middlex) {@{term "A ∩ L"}};
\draw[->] (owned.east |- roshared.170) -- (roshared.170);
\node [above] at (roshared.170 -| middlex) {@{term "R ∩ - W"}};
\draw[->] (oshared.292) -- node {@{term "A ∩ L"}} (onshared.68);
\draw[->] (onshared.84) -- node {@{term "A ∩ - L"}} (oshared.276);
\node (legende) [below right] at (owned.south west) {(A)cquire, keep (L)ocal; (R)elease, mark (W)riteable };
\end{tikzpicture}
\end{center}
\caption{Ownership transfer \label{fig:ownership-transfer}}
\end{figure}
%
A memory instruction is a datatype with the following constructors:
\begin{itemize}
\item @{term "Read volatile a t"} for reading from address @{term "a"} to temporary @{term "t"}, where the Boolean @{term "volatile"} determines whether the access is volatile or not.
\item @{term "Write volatile a sop A L R W"} to write the result of evaluating the store operation @{term "sop"} at address @{term "a"}. A store operation is a pair @{term "(D,f)"}, with the domain @{term "D"} and the function @{term "f"}.
The function @{term "f"} takes temporaries @{term "θ"} as a parameter, which maps a temporary to a value.
The subset of temporaries that is considered by function @{term "f"} is specified by the domain @{term "D"}.
We consider store operations as valid when they only depend on their domain:
@{thm [display]"valid_sop_def" [simplified conj_to_impl [symmetric], no_vars]}
Again the Boolean @{term "volatile"} specifies the kind of memory access.
\item @{term "RMW a t sop cond ret A L R W"}, for atomic interlocked `read-modify-write' instructions (flushing the store buffer). First the value at address @{term "a"} is loaded to temporary @{term "t"}, and then the condition @{term "cond"} on the temporaries is considered to decide whether a store operation is also executed. In case of a store the function @{term "ret"}, depending on both the old value at address @{term "a"} and the new value (according to store operation @{term "sop"}), specifies the final result stored in temporary @{term "t"}. With a trivial condition @{term "cond"} this instruction also covers interlocked reads and writes.
\item @{term "Fence"}, a memory fence that flushes the store buffer. %todo: rename to flush?
\item @{term "Ghost A L R W"} for ownership transfer.
\end{itemize}
›
subsection ‹Store buffer machine \label{sec:storebuffermachine}›
text (in program) ‹
For the store buffer machine the configuration of a single thread is a tuple @{term "(p, is, θ, sb)"} consisting of the program state @{term "p"}, a memory instruction list @{term "is"}, the map of temporaries @{term "θ"} and the store buffer @{term "sb"}. A global configuration of the store buffer machine @{term "(ts, m)"} consists of a list of thread configurations @{term "ts"} and the memory @{term "m"}, which is a function from addresses to values.
We describe the computation of the global system by the non-deterministic transition relation @{term "(ts, m, ()) ⇒⇩s⇩b (ts', m',())"} defined in Figure~\ref{fig:global-transitions}.
\begin{figure}[H]
\begin{center}
@{thm [mode=Rule] store_buffer.concurrent_step.Program
[where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] store_buffer.concurrent_step.Memop [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()"
and 𝒟'="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] store_buffer.concurrent_step.StoreBuffer [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]}
\end{center}
\caption{Global transitions of store buffer machine\label{fig:global-transitions}}
\end{figure}
A transition selects a thread @{term "ts!i = (p,is,θ,sb,(),())"} and either the `program' the `memory' or the `store buffer' makes a step defined by sub-relations.
The program step relation is a parameter to the global
transition relation. A program step @{thm (prem 3) "store_buffer.concurrent_step.Program" [no_vars]} takes the temporaries @{term "θ"} and the current program state @{term "p"} and makes a step by returning a new program state @{term "p'"} and an instruction list @{term "is'"} which is appended to the remaining instructions.
A memory step @{thm (prem 3) "store_buffer.concurrent_step.Memop" [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()"
and 𝒟'="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]} of a machine with store buffer may only fill its store buffer with new writes.
In a store buffer step @{thm (prem 3) "store_buffer.concurrent_step.StoreBuffer" [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()" and 𝒪'="()" and ℛ'="()" and 𝒮'="()",no_vars]} the store buffer may release outstanding writes to the memory.
The store buffer maintains the list of outstanding memory writes.
Write instructions are appended to the end of the store buffer and emerge to memory from the front of the list. A read instructions is satisfied from the store buffer if possible.
An entry in the store buffer is of the form @{term "Write⇩s⇩b volatile a sop v"} for an outstanding write (keeping the volatile flag), where operation @{term "sop"} evaluated to value @{term "v"}.
As defined in Figure \ref{fig:store-buffer-transition} a write updates the memory when it exits the store buffer.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] SBWrite⇩s⇩b [where rs=sb and 𝒪="()" and ℛ="()" and 𝒮="()", no_vars]}\\[0.5\baselineskip]
\end{center}
\caption{Store buffer transition \label{fig:store-buffer-transition}}
\end{figure}
%
The memory transition are defined in Figure \ref{fig:store-buffer-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] SBRead [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBWrite' [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBRMWReadOnly' [where ghst="((),(),(),())",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBRMWWrite' [where ghst="((),(),(),())",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] sb_memop_step.SBFence [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] sb_memop_step.SBGhost [where 𝒟="()" and 𝒪="()" and ℛ="()" and 𝒮="()",no_vars]}
\end{center}
\caption{Memory transitions of store buffer machine\label{fig:store-buffer-memory}}
\end{figure}
%
With @{term "buffered_val sb a"} we obtain the value of the last write to address @{term "a"} which is still pending in the store buffer.
In case no outstanding write is in the store buffer we read from the memory.
Store operations have no immediate effect on the memory but are queued in the store buffer instead.
Interlocked operations and the fence operation require an empty store buffer, which means that it has to be flushed before the action can take place.
The read-modify-write instruction first adds the current value at address @{term "a"} to temporary @{term "t"} and then checks the store condition @{term "cond"} on the temporaries.
If it fails this read is the final result of the operation.
Otherwise the store is performed.
The resulting value of the temporary @{term "t"} is specified by the function @{term "ret"} which considers both the old and new value as input.
The fence and the ghost instruction are just skipped.
›
subsection ‹Virtual machine \label{sec:virtualmachine}›
text (in program) ‹
The virtual machine is a sequentially consistent machine without store buffers, maintaining additional ghost state to check for the programming discipline.
A thread configuration is a tuple @{term "(p, is, θ, (), 𝒟, 𝒪,())"}, with a dirty flag @{term "𝒟"} indicating whether there may be an outstanding volatile write in the store buffer and the set of owned addresses @{term "𝒪"}.
The dirty flag @{term "𝒟"} is considered to specify if a read is clean: for \emph{all} volatile reads the dirty flag must not be set.
The global configuration of the virtual machine @{term "(ts, m,𝒮)"} maintains a Boolean map of shared addresses @{term "𝒮"} (indicating write permission).
Addresses in the domain of mapping @{term "𝒮"} are considered shared and the set of read-only addresses is obtained from @{term "𝒮"} by: @{thm "read_only_def" [no_vars]}
According to the rules in Fig \ref{fig:global-virtual-step} a global transition of the virtual machine
@{term "(ts, m, 𝒮) ⇒⇩v (ts', m', 𝒮')"} is either a program or a memory step.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] virtual.concurrent_step.Program [where sb="()" and ℛ="()", no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] virtual.concurrent_step.Memop [where sb="()" and sb'="()" and ℛ="()" and ℛ'="()",no_vars]}
\end{center}
\caption{Global transitions of virtual machine \label{fig:global-virtual-step}}
\end{figure}
The transition rules for its memory system are defined in Figure~\ref{fig:virtual-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] VRead [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] VWriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VWriteVolatile [where ℛ="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VRMWReadOnly [where ℛ="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VRMWWrite [where ℛ="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VFence [where ℛ="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] VGhost [where ℛ="()", no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Memory transitions of the virtual machine \label{fig:virtual-memory}}
\end{figure}
%
In addition to the transition rules for the virtual machine we introduce the \emph{safety} judgment @{term "𝒪s,i⊢ (is, θ, m, 𝒟, 𝒪, 𝒮)√"} in Figure~\ref{fig:safe-virtual-memory}, where @{term "𝒪s"} is the list of ownership sets obtained from the thread list @{term "ts"} and @{term "i"} is the index of the current thread.
Safety of all reachable states of the virtual machine ensures that the programming discipline is obeyed by the program and is our formal prerequisite for the simulation theorem.
It is left as a proof obligation to be discharged by means of a proper program logic for sequentially consistent executions.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] safe_direct_memop_state.Read [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_direct_memop_state.WriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeWriteVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeRMWReadOnly [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeRMWWrite [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] safe_direct_memop_state.Fence [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_direct_memop_state.Ghost [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Safe configurations of a virtual machine \label{fig:safe-virtual-memory}}
\end{figure}
%
%
In the following we elaborate on the rules of Figures \ref{fig:virtual-memory} and \ref{fig:safe-virtual-memory} in parallel.
To read from an address it either has to be owned or read-only or it has to be volatile and shared. Moreover the read has to be clean.
%TODO: mention the difference distinction of 'single writer' that covered by this: for 'owned and shared' non-volatile read is ok
The memory content of address @{term "a"} is stored in temporary @{term "t"}.
%
Non-volatile writes are only allowed to owned and unshared addresses.
The result is written directly into the memory.
%
A volatile write is only allowed when no other thread owns the address and the address is not marked as read-only.
Simultaneously with the volatile write we can transfer ownership as specified by the annotations @{term "A"}, @{term "L"}, @{term "R"} and @{term "W"}.
The acquired addresses @{term "A"} must not be owned by any other thread and stem from the shared addresses or are already owned.
Reacquiring owned addresses can be used to change the shared-status via the set of local addresses @{term "L"} which have to be a subset of @{term "A"}.
The released addresses @{term "R"} have to be owned and distinct from the acquired addresses @{term "A"}.
After the write the new ownership set of the thread is obtained by adding the acquired addresses @{term "A"} and releasing the addresses @{term "R"}: @{term "𝒪 ∪ A - R"}. The released addresses @{term "R"} are augmented to the shared addresses @{term "S"} and the local addresses @{term "L"} are removed. We also take care about the write permissions in the shared state: the released addresses in set @{term "W"} as well as the acquired addresses are marked writable: @{term "𝒮 ⊕⇘W⇙ R ⊖⇘A⇙ L"}. The auxiliary ternary operators to augment and subtract addresses from the sharing map are defined as follows:
@{thm [display] augment_shared_def [where S=R, no_vars]}
@{thm [display,margin=80] restrict_shared_def [no_vars]}
The read-modify-write instruction first adds the current value at address @{term "a"} to temporary @{term "t"} and then checks the store condition @{term "cond"} on the temporaries.
If it fails this read is the final result of the operation.
Otherwise the store is performed.
The resulting value of the temporary @{term "t"} is specified by the function @{term "ret"} which considers both the old and new value as input.
As the read-modify-write instruction is an interlocked operation which flushes the store buffer as a side effect the dirty flag @{term "𝒟"} is reset.
The other effects on the ghost state and the safety sideconditions are the same as for the volatile read and volatile write, respectively.
The only effect of the fence instruction in the system without store buffer is to reset the dirty flag.
The ghost instruction @{term "Ghost A L R W"} allows to transfer ownership when no write is involved \ie when merely reading from memory. It has the same safety requirements as the corresponding parts in the write instructions.
›
subsection ‹Reduction \label{sec:reduction}›
text (in xvalid_program_progress) ‹
The reduction theorem we aim at reduces a computation of a machine with store buffers to a sequential consistent computation of the virtual machine. We formulate this as a
simulation theorem which states that a computation of the store buffer machine @{term "(ts⇩s⇩b,m,()) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m',())"} can be simulated by a computation of the virtual machine @{term "(ts,m,𝒮) ⇒⇩v⇧* (ts',m',𝒮')"}.
The main theorem only considers computations that start in an initial configuration where all store buffers are empty and end in a configuration where all store buffers are empty again. A configuration of the store buffer machine is obtained from a virtual configuration by removing all ghost components and assuming empty store buffers. This coupling relation between the thread configurations is written as @{term "ts⇩s⇩b ∼⇩d ts"}. Moreover, the precondition @{term "initial⇩v ts 𝒮 valid"} ensures that the ghost state of the initial configuration of the virtual machine is properly initialized: the ownership sets of the threads are distinct, an address marked as read-only (according to @{term 𝒮}) is unowned and every unowned address is shared. %TODO (ommit): and the instruction lists are empty.
Finally with @{term [names_short] "safe_reach_virtual_free_flowing (ts,m,S)"} we ensure conformance to the programming discipline by assuming that all reachable configuration in the virtual machine are safe (according to the rules in Figure~\ref{fig:safe-virtual-memory}).
%
\begin{theorem}[Reduction]\label{thm:reduction}
@{thm [display, mode=compact, mode=holimplnl, margin=90,names_short] store_buffer_execution_result_sequential_consistent'_hol [where x="()" and x'="()",no_vars]}
\end{theorem}
%
This theorem captures our intiution that every result that can be obtained from a computation of the store buffer machine can also be obtained by a sequentially consistent computation. However, to prove it we need some generalizations that we sketch in the following sections. First of all the theorem is not inductive as we do not consider arbitrary intermediate configurations but only those where all store buffers are empty. For intermediate confiugrations the coupling relation becomes more involved. The major obstacle is that a volatile read (from memory) can overtake non-volatile writes that are still in the store-buffer and have not yet emerged to memory. Keep in mind that our programming discipline only ensures that no \emph{volatile} writes can be in the store buffer the moment we do a volatile read, outstanding non-volatile writes are allowed. This reordering of operations is reflected in the coupling relation for intermediate configurations as discussed in the following section.
›
section ‹Building blocks of the proof \label{sec:buildingblocks}›
text (in program) ‹
A corner stone of the proof is a proper coupling relation between an \emph{intermediate} configuration of a machine with store buffers and the virtual machine without store buffers.
It allows us to simulate every computation step of the store buffer machine by a sequence of steps (potentially empty) on the virtual machine.
This transformation is essentially a sequentialization of the trace of the store buffer machine.
When a thread of the store buffer machine executes a non-volatile operation, it only accesses memory which is not modified by any other thread (it is either owned or read-only).
Although a non-volatile store is buffered, we can immediately execute it on the virtual machine, as there is no competing store of another thread.
However, with volatile writes we have to be careful, since concurrent threads may also compete with some volatile write to the same address.
At the moment the volatile write enters the store buffer we do not yet know when it will be issued to memory and how it is ordered relatively to other outstanding writes of other threads.
We therefore have to suspend the write on the virtual machine from the moment it enters the store buffer to the moment it is issued to memory.
For volatile reads our programming discipline guarantees that there is no volatile write in the store buffer by flushing the store buffer if necessary.
So there are at most some outstanding non-volatile writes in the store buffer, which are already executed on the virtual machine, as described before.
One simple coupling relation one may think of is to suspend the whole store buffer as not yet executed intructions of the virtual machine. However, consider the following scenario. A thread is reading from a volatile address.
It can still have non-volatile writes in its store buffer.
Hence the read would be suspended in the virutal machine, and other writes to the address (e.g. interlocked or volatile writes of another thread) could invalidate the value.
Altogether this suggests the following refined coupling relation: the state of the virtual machine is obtained from the state of the store buffer machine, by executing each store buffer until we reach the first volatile write.
The remaining store buffer entries are suspended as instructions. As we only execute non volatile writes the order in which we execute the store buffers should be irrelevant.
This coupling relation allows a volatile read to be simulated immediately on the virtual machine as it happens on the store buffer machine.
From the viewpoint of the memory the virtual machine is ahead of the store buffer machine, as leading non-volatile writes already took effect on the memory of the virtual machine while they are still pending in the store buffer.
However, if there is a volatile write in the store buffer the corresponding thread in the virtual machine is suspended until the write leaves the store buffer.
So from the viewpoint of the already executed instructions the store buffer machine is ahead of the virtual machine. To keep track of this delay we introduce a variant of the store buffer machine below, which maintains the history of executed instructions in the store buffer (including reads and program steps). Moreover, the intermediate machine also maintains the ghost state of the virtual machine to support the coupling relation. We also introduce a refined version of the virutal machine below, which we try to motivate now.
Esentially the programming discipline only allows races between volatile (or interlocked) operations. By race we mean two competing memory accesses of different threads of which at least one is a write.
For example the discipline guarantees that a volatile read may not be invalidated by a non-volatile write of another thread.
While proving the simulation theorem this manifests in the argument that a read of the store-buffer machine and the virtual machine sees the same value in both machines: the value seen by a read in the store buffer machine stays valid as long as it has not yet made its way out in the virtual machine.
To rule out certain races from the execution traces we make use of the programming discipline, which is formalized in the safety of all reachable configurations of the virtual machine. Some races can be ruled out by continuing the computation of the virtual machine until we reach a safety violation.
However, some cannot be ruled out by the future computation of the current trace, but can be invalidated by a safety violation of another trace that deviated from the current one at some point in the past. Consider two threads.
Thread 1 attempts to do a volatile read from address @{term a} which is currently owned (and not shared) by thread 2, which attempts to do a non-volatile write on @{term a} with value @{term "42::nat"} and then release the address.
In this configuration there is already a safety violation. Thread 1 is not allowed to perform a volatile read from an address that is not shared.
However, when Thread 2 has executed his update and has released ownership (both are non-volatile operations) there is no safety violation anymore.
Unfortunately this is the state of the virtual machine when we consider the instructions of Thread 2 to be in the store buffer. The store buffer machine and the virtual machine are out of sync.
Whereas in the virtual machine Thread 1 will already read @{term "42::nat"} (all non-volatile writes are already executed in the virtual machine), the non-volatile write may still be pending in the store buffer of Thread 2 and hence Thread 1 reads the old value in the store buffer machine.
This kind of issues arise when a thread has released ownership in the middle of non-volatile operations of the virtual machine, but the next volatile write of this thread has not yet made its way out of the store buffer.
When another thread races for the released address in this situation there is always another scheduling of the virtual machine where the release has not yet taken place and we get a safety violation.
To make these safety violations visible until the next volatile write we introduce another ghost component that keeps track of the released addresses.
It is augmented when an ghost operation releases an address and is reset as the next volatile write is reached.
Moreover, we refine our rules for safety to take these released addresses into account.
For example, a write to an released address of another thread is forbidden.
We refer to these refined model as \emph{delayed releases} (as no other thread can acquire the address as long as it is still in the set of released addresses) and to our original model as \emph{free flowing releases} (as the effect of a release immediate takes place at the point of the ghost instruction).
Note that this only affects ownership transfer due to the @{term Ghost} instruction.
Ownership transfer together with volatile (or interlocked) writes happen simultaneously in both models.
Note that the refined rules for delayed releases are just an intermediate step in our proof.
They do not have to be considered for the final programming discipline. As sketched above we can show in a separate theorem that a safety violation in a trace with respect to delayed releases implies a safety violation of a (potenitally other) trace with respect to free flowing releases. Both notions of safety collaps in all configurations where there are no released addresses, like the initial state. So if all reachable configurations are safe with respect to free flowing releases they are also safe with respect to delayed releases. This allows us to use the stricter policy of delayed releases for the simulation proof.
Before continuing with the coupling relation, we introduce the refined intermediate models for delayed releases and store buffers with history information.
›
subsection ‹Intermediate models›
text (in program) ‹
We begin with the virtual machine with delayed releases, for which the memory transitions
@{term "(is,θ,(),m,𝒟,𝒪,ℛ,𝒮) → (is',θ',(),m',𝒟',𝒪',ℛ',𝒮')"}
are defined Figure \ref{fig:virtual-delayed-memory}.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] DRead [where x="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] DWriteNonVolatile [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DWriteVolatile [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DRMWReadOnly [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] DRMWWrite [where x="()",no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom,names_short] direct_memop_step.Fence [where x="()",no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] DGhost [where x="()",no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Memory transitions of the virtual machine with delayed releases\label{fig:virtual-delayed-memory}}
\end{figure}
%
The additional ghost component @{term "ℛ"} is a mapping from addresses to a Boolean flag. If an address is in the domain of @{term ℛ} it was released. The boolean flag is considered to figure out if the released address was previously shared or not. In case the flag is @{term True} it was shared otherwise not. This subtle distinction is necessary to properly handle volatile reads. A volatile read from an address owned by another thread is fine as long as it is marked as shared. The released addresses @{term ℛ} are reset at every volatile write as well as interlocked operations and the fence instruction. They are augmented at the ghost instruction taking the sharing information into account:
@{thm [display] augment_rels_def [where S="dom 𝒮", no_vars]}
If an address is freshly released (@{term "a ∈ R"} and @{term "ℛ a = None"}) the flag is set according to @{term "dom 𝒮"}. Otherwise the flag becomes @{term "Some False"} in case the released address is currently unshared.
Note that with this definition @{term "ℛ a = Some False"} stays stable upon every new release and we do not loose information about a release of an unshared address.
The global transition @{term "(ts, m, s) ⇒⇩d (ts',m',s')"} are analogous to the rules in Figure \ref{fig:global-virtual-step} replacing the memory transtions with the refined version for delayed releases.
The safety judgment for delayed releases @{term "𝒪s,ℛs,i⊢ (is, θ, m, 𝒟, 𝒪, 𝒮)√"} is defined in Figure \ref{fig:safe-delayed}. Note the additional component @{term ℛs} which is the list of release maps of all threads.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] safe_delayed_direct_memop_state.Read [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.WriteNonVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedWriteVolatile [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedRMWReadOnly [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SafeDelayedRMWWrite [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] safe_delayed_direct_memop_state.Fence [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.Ghost [no_vars]}\\[0.1\baselineskip]
@{thm [mode=Rule] safe_delayed_direct_memop_state.Nil [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Safe configurations of a virtual machine (delayed-releases) \label{fig:safe-delayed}}
\end{figure}
%
The rules are strict extensions of the rules in Figure \ref{fig:safe-virtual-memory}: writing or acquiring an address @{term a} is only allowed if the address is not in the release set of another thread (@{term "a ∉ dom (ℛs!j)"}); reading from an address is only allowed if it is not released by another thread while it was unshared (@{term "(ℛs!j) a ≠ Some False"}).
For the store buffer machine with history information we not only put writes into the store buffer but also record reads, program steps and ghost operations.
This allows us to restore the necessary computation history of the store buffer machine and relate it to the virtual machine which may fall behind the store buffer machine during execution.
Altogether an entry in the store buffer is either a
\begin{itemize}
\item @{term "Read⇩s⇩b volatile a t v"}, recording a corresponding read from address @{term "a"} which loaded the value @{term "v"} to temporary @{term "t"}, or a
\item @{term "Write⇩s⇩b volatile a sop v"} for an outstanding write, where operation @{term "sop"} evaluated to value @{term "v"}, or of the form
\item @{term "Prog⇩s⇩b p p' is'"}, recording a program transition from @{term "p"} to @{term "p'"} which issued instructions @{term "is'"}, or of the form
\item @{term "Ghost⇩s⇩b A L R W"}, recording a corresponding ghost operation.
\end{itemize}
As defined in Figure \ref{fig:store-buffer-transitions} a write updates the memory when it exits the store buffer, all other store buffer entries may only have an effect on the ghost state. The effect on the ownership information is analogous to the corresponding operations in the virtual machine.
%
\begin{figure}
\begin{center}
@{thm [mode=Axiom] Write⇩s⇩bNonVolatile [where rs=sb, no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule, names_short] Write⇩s⇩bVolatile [where rs=sb, no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] flush_step.Read⇩s⇩b [where rs=sb, no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] flush_step.Prog⇩s⇩b [where rs=sb, no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] Ghost⇩s⇩b [where rs=sb, no_vars]}
\end{center}
\caption{Store buffer transitions with history\label{fig:store-buffer-transitions}}
\end{figure}
%
The memory transitions defined in Figure \ref{fig:store-buffer-history-memory} are straightforward extensions
of the store buffer transitions of Figure \ref{fig:store-buffer-history-memory} augmented with ghost state
and recording history information in the store buffer. Note how we deal with the ghost state.
Only the dirty flag is updated when the instruction enters the store buffer, the ownership transfer
takes effect when the instruction leaves the store buffer.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] SBHRead [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBHWriteNonVolatile' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] SBHWriteVolatile' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] SBHRMWReadOnly' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule,names_short] SBHRMWWrite' [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom,names_short] sbh_memop_step.SBHFence [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SBHGhost' [no_vars]}
\end{center}
\caption{Memory transitions of store buffer machine with history\label{fig:store-buffer-history-memory}}
\end{figure}
%
The global transitions @{term "(ts⇩s⇩b⇩h, m, 𝒮) ⇒⇩s⇩b⇩h (ts⇩s⇩b⇩h',m',𝒮')"} are analogous to the rules in Figure \ref{fig:global-transitions} replacing the memory transtions and store buffer transtiontions accordingly.
›
subsection ‹Coupling relation \label{sec:couplingrelation}›
text (in program) ‹
After this introduction of the immediate models we can proceed to the details of the coupling relation, which relates configurations of the store buffer machine with histroy and the virtual machine with delayed releases.
Remember the basic idea of the coupling relation: the state of the virtual machine is obtained from the state of the store buffer machine, by executing each store buffer until we reach the first volatile write. The remaining store buffer entries are suspended as instructions. The instructions now also include the history entries for reads, program steps and ghost operations.
The suspended reads are not yet visible in the temporaries of the virtual machine.
Similar the ownership effects (and program steps) of the suspended operations are not yet visible in the virtual machine.
The coupling relation between the store buffer machine and the virtual machine is illustrated in Figure~\ref{fig:coupling-relation-pic}. The threads issue instructions to the store buffers from the right and the instructions emerge from the store buffers to main memory from the left. The dotted line illustrates the state of the virtual machines memory. It is obtained from the memory of the store buffer machine by executing the purely non-volatile prefixes of the store buffers. The remaining entries of the store buffer are still (suspended) instructions in the virtual machine.
\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered, outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]
\tikzstyle{virtual}=[dotted]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};
\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: $i_i^0$, $i_i^1$, $\dots$};
\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};
\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};
\path (sbr1.north east) to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east) to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east) to node [near end,left] {$\vdots$} (sbr2.south east);
\node (sblabel)[above] at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above] at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};
%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners] (memNorthWest) rectangle (memSouthEast) node [midway] {@{term "m⇩s⇩b⇩h"}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north west) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south west);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);
\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
to ($ (sbr3.south west)$);
\node (execslabel)[below] at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below] at ($ (sbr3.south)$) {suspended};
\end{tikzpicture}
\caption{Illustration of coupling relation \label{fig:coupling-relation-pic}}
\end{figure}
Consider the following configuration of a thread @{term "ts⇩s⇩b⇩h ! j"} in the store buffer machine, where @{term "i⇩k"} are the instructions and @{term "s⇩k"} the store buffer entries.
Let @{term "s⇩v"} be the first volatile write in the store buffer.
Keep in mind that new store buffer entries are appended to the end of the list and entries exit the store buffer and are issued to memory from the front of the list.
%
\begin{center}
@{term "ts⇩s⇩b⇩h ! j = (p,[i⇩1,…,i⇩n], θ, [s⇩1,…,s⇩v,s⇩𝔳,…,s⇩m], 𝒟, 𝒪, ℛ)"}
\end{center}
%
The corresponding configuration @{term "ts ! j"} in the virtual machine is obtained by suspending all store buffer entries beginning at @{term "s⇩v"} to the front of the instructions.
A store buffer @{term "Read⇩s⇩b"} / @{term "Write⇩s⇩b"} / @{term "Ghost⇩s⇩b"} is converted to a @{term "Read"} / @{term "Write"} / @{term "Ghost"} instruction.
We take the freedom to make this coercion implicit in the example.
The store buffer entries preceding @{term "s⇩v"} have already made their way to memory, whereas the suspended read operations are not yet visible in the temporaries @{term "θ'"}. Similar, the suspended updates to the ownership sets and dirty flag are not yet recorded in @{term "𝒪'"}, @{term "ℛ'"} and @{term "𝒟'"}.
%
\begin{center}
@{term "ts ! j =(p,[s⇩v,s⇩𝔳,…,s⇩m,i⇩1,…,i⇩n], θ', (), 𝒟', 𝒪',ℛ')"}
\end{center}
%
This example illustrates that the virtual machine falls behind the store buffer machine in our simulation, as store buffer instructions are suspended and reads (and ghost operations) are delayed and not yet visible in the temporaries (and the ghost state).
This delay can also propagate to the level of the programming language, which communicates with the memory system by reading the temporaries and issuing new instructions.
For example the control flow can depend on the temporaries, which store the result of branching conditions.
It may happen that the store buffer machine already has evaluated the branching condition by referring to the values in the store buffer, whereas the virtual machine still has to wait.
Formally this manifests in still undefined temporaries.
Now consider that the program in the store buffer machine makes a step from @{term "p"} to @{term "(p',is')"}, which results in a thread configuration where the program state has switched to @{term "p'"}, the instructions @{term "is'"} are appended and the program step is recorded in the store buffer:
%
\begin{center}
@{term "ts⇩s⇩b⇩h' ! j = (p',[i⇩1,…,i⇩n]@is', θ, [s⇩1,…,s⇩v,…,s⇩m,Prog⇩s⇩b p p' is'], 𝒟, 𝒪, ℛ)"}
\end{center}
%
The virtual machine however makes no step, since it still has to evaluate the suspended instructions before making the program step.
The instructions @{term "is'"} are not yet issued and the program state is still @{term "p"}.
We also take these program steps into account in our final coupling relation @{thm (concl) sim_config' [no_vars]}, defined in Figure~\ref{fig:coupling-relation}.
%
\begin{figure}
\begin{center}
\begin{minipage}{10cm}
\inferrule{@{thm (prem 1) sim_config' [no_vars]}\\
@{thm (prem 2) sim_config' [no_vars]}\\
@{thm (prem 3) sim_config' [no_vars]}\\
\parbox{9.8cm}{@{thm [break,mode=letnl,margin=80] (prem 4) sim_config' [simplified restrict_map_inverse, no_vars]}}}
%
{@{thm (concl) sim_config' [no_vars]}}
\end{minipage}
\end{center}
\caption{Coupling relation \label{fig:coupling-relation}}
\end{figure}
%
We denote the already simulated store buffer entries by @{term "Bind execs. execs"} and the suspended ones by @{term "Bind suspends. suspends"}.
The function @{term "instrs"} converts them back to instructions, which are a prefix of the instructions of the virtual machine.
We collect the additional instructions which were issued by program instructions but still recorded in the remainder of the store buffer with function @{term "prog_instrs"}.
These instructions have already made their way to the instructions of the store buffer machine but not yet on the virtual machine.
This situation is formalized as @{term "Bind suspends is⇩s⇩b⇩h is. instrs suspends @ is⇩s⇩b⇩h = is @ prog_instrs suspends"}, where @{term "Bind is. is"} are the instructions of the virtual machine.
The program state of the virtual machine is either the same as in the store buffer machine or the first program state recorded in the suspended part of the store buffer.
This state is selected by @{const "hd_prog"}.
The temporaries of the virtual machine are obtained by removing the suspended reads from @{term "θ"}.
The memory is obtained by executing all store buffers until the first volatile write is hit, excluding it. Thereby only non-volatile writes are executed, which are all thread local, and hence could be executed in any order with the same result on the memory. Function @{const "flush_all_until_volatile_write"} executes them in order of appearance.
Similarly the sharing map of the virtual machine is obtained by executing all store buffers until the first volatile write via the function @{const "share_all_until_volatile_write"}. For the local ownership set @{term "𝒪⇩s⇩b⇩h"} the auxiliary function @{term "acquire"} calculates the outstanding effect of the already simulated parts of the store buffer. Analogously @{term "release"} calculates the effect for the released addresses @{term "ℛ⇩s⇩b⇩h"}.
›
subsection ‹Simulation \label{sec:simulation}›
text (in xvalid_program_progress) ‹
Theorem \ref{thm:simulation} is our core inductive simulation theorem.
Provided that all reachable states of the virtual machine (with delayed releases) are safe, a step of the store buffer machine (with history) can be simulated by a (potentially empty) sequence of steps on the virtual machine, maintaining the coupling relation and an invariant on the configurations of the store buffer machine.
%
\begin{theorem}[Simulation]\label{thm:simulation}
@{thm [display, mode=holimplnl,margin=100] simulation_hol [no_vars]}
\end{theorem}
%
In the following we discuss the invariant @{term [names_short] "invariant ts⇩s⇩b⇩h S⇩s⇩b⇩h m⇩s⇩b⇩h"}, where we commonly refer to a thread configuration @{term "ts⇩s⇩b⇩h!i = (p,is,θ,sb,𝒟,𝒪,ℛ)"} for @{term "i < length ts⇩s⇩b⇩h"}.
By outstanding references we refer to read and write operations in the store buffer.
The invariant is a conjunction of several sub-invariants grouped by their content:
@{thm [display, names_short, mode=compact, margin=100] invariant_grouped_def [of ts⇩s⇩b⇩h S⇩s⇩b⇩h m⇩s⇩b⇩h]}
%TODO make grouping formally, hide program step in valid_history
\paragraph{Ownership.}
\begin{inparaenum}
\item \label{inv-ownership:owned-or-read-only} For every thread all outstanding non-volatile references have to be owned or refer to read-only memory.
\item Every outstanding volatile write is not owned by any other thread.
\item Outstanding accesses to read-only memory are not owned.
\item \label{inv-ownership:distinct-ownership} The ownership sets of every two different threads are distinct.
\end{inparaenum}
\paragraph{Sharing.}
\begin{inparaenum}
\item \label{inv-sharing:non-volatile-writes-unshared} All outstanding non volatile writes are unshared.
\item All unowned addresses are shared.
\item No thread owns read-only memory.
\item The ownership annotations of outstanding ghost and write operations are consistent (\eg released addresses are owned at the point of release).
\item \label{inv-sharing:no-write-to-read-only-memory} There is no outstanding write to read-only memory.
\end{inparaenum}
\paragraph{Temporaries.} Temporaries are modeled as an unlimited store for temporary registers. We require certain distinctness and freshness properties for each thread.
\begin{inparaenum}
\item The temporaries referred to by read instructions are distinct.
\item The temporaries referred to by reads in the store buffer are distinct.
\item Read and write temporaries are distinct.
\item Read temporaries are fresh, \ie are not in the domain of @{term "θ"}.
\end{inparaenum}
\paragraph{Data dependency.} Data dependency means that store operations may only depend on \emph{previous} read operations. For every thread we have:
\begin{inparaenum}
\item Every operation @{term "(D, f)"} in a write instruction or a store buffer write is valid according to @{term "valid_sop (D, f)"}, \ie function @{term "f"} only depends on domain @{term "D"}.
\item For every suffix of the instructions of the form @{term "Write volatile a (D,f) A L R W#is"} the domain @{term "D"} is distinct from the temporaries referred to by future read instructions in @{term "is"}.
\item The outstanding writes in the store buffer do not depend on the read temporaries still in the instruction list.
\end{inparaenum}
\paragraph{History.} The history information of program steps and read operations we record in the store buffer have to be consistent with the trace. For every thread:
\begin{inparaenum}
\item The value stored for a non volatile read is the same as the last write to the same address in the store buffer or the value in memory, in case there is no write in the buffer.
\item All reads have to be clean. This results from our flushing policy. Note that the value recorded for a volatile read in the initial part of the store buffer (before the first volatile write), may become stale with respect to the memory. Remember that those parts of the store buffer are already executed in the virtual machine and thus cause no trouble.
\item For every read the recorded value coincides with the corresponding value in the temporaries.
\item For every @{term "Write⇩s⇩b volatile a (D,f) v A L R W"} the recorded value @{term "v"} coincides with @{term "f θ"}, and domain @{term "D"} is subset of @{term "dom θ"} and is distinct from the following read temporaries. Note that the consistency of the ownership annotations is already covered by the aforementioned invariants.
\item For every suffix in the store buffer of the form @{term "Prog⇩s⇩b p⇩1 p⇩2 is'#sb'"}, either @{term "p⇩1 = p"} in case there is no preceding program node in the buffer or it corresponds to the last program state recorded there.
Moreover, the program transition @{term "θ|`(- read_tmps sb')⊢ p⇩1 →⇩p (p⇩2,is')"} is possible, \ie it was possible to execute the program transition at that point.
\item The program configuration @{term "p"} coincides with the last program configuration recorded in the store buffer.
\item As the instructions from a program step are at the one hand appended to the instruction list and on the other hand recorded in the store buffer, we have for every suffix @{term "sb'"} of the store buffer: @{term "∃is'. instrs sb' @ is = is' @ prog_instrs sb'"}, \ie the remaining instructions @{term "is"} correspond to a suffix of the recorded instructions @{term "prog_instrs sb'"}.
\end{inparaenum}
\paragraph{Flushes.} If the dirty flag is unset there are no outstanding volatile writes in the store buffer.
\paragraph{Program step.} The program-transitions are still a parameter of our model.
In order to make the proof work, we have to assume some of the invariants also for the program steps.
We allow the program-transitions to employ further invariants on the configurations, these are modeled by the parameter @{term "valid"}.
For example, in the instantiation later on the program keeps a counter for the temporaries, for each thread.
We maintain distinctness of temporaries by restricting all temporaries occurring in the memory system to be below that counter, which is expressed by instantiating @{term "valid"}.
Program steps, memory steps and store buffer steps have to maintain @{term "valid"}.
Furthermore we assume the following properties of a program step:
\begin{inparaenum}
\item The program step generates fresh, distinct read temporaries, that are neither in @{term "θ"} nor in the store buffer temporaries of the memory system.
\item The generated memory instructions respect data dependencies, and are valid according to @{term "valid_sop"}.
%TODO: maybe we can omit the formal stuff, intuition should be clear, depends on what we write on PIMP.
\end{inparaenum}
\paragraph{Proof sketch.} We do not go into details but rather first sketch the main arguments for simulation of a step in the store buffer machine by a potentially empty sequence of steps in the virtual machine, maintaining the coupling relation. Second we exemplarically focus on some cases to illustrate common arguments in the proof.
The first case distinction in the proof is on the global transitions in Figure~\ref{fig:global-transitions}.
%
\begin{inparaenum}
\item \emph{Program step}:
we make a case distinction whether there is an outstanding volatile write in the store buffer or not.
If not the configuration of the virtual machine corresponds to the executed store buffer and we can make the same step.
Otherwise the virtual machine makes no step as we have to wait until all volatile writes have exited the store buffer.
%
\item \emph{Memory step}:
we do case distinction on the rules in Figure~\ref{fig:store-buffer-history-memory}.
For read, non volatile write and ghost instructions we do the same case distinction as for the program step.
If there is no outstanding volatile write in the store buffer we can make the step, otherwise we have to wait.
When a volatile write enters the store buffer it is suspended until it exists the store buffer. Hence we do no step in the virtual machine.
The read-modify-write and the fence instruction can all be simulated immediately since the store buffer has to be empty.
%
\item \emph{Store Buffer step}:
we do case distinction on the rules in Figure~\ref{fig:store-buffer-transitions}.
When a read, a non volatile write, a ghost operation or a program history node exits the store buffer, the virtual machine does not have to do any step since these steps are already visible.
When a volatile write exits the store buffer, we execute all the suspended operations (including reads, ghost operations and program steps) until the next suspended volatile write is hit. This is possible since all writes are non volatile and thus memory modifications are thread local.
\end{inparaenum}
In the following we exemplarically describe some cases in more detail to give an impression on the typical arguments in the proof.
We start with a configuration @{term "c⇩s⇩b⇩h=(ts⇩s⇩b⇩h,m⇩s⇩b⇩h,𝒮⇩s⇩b⇩h)"} of the store buffer machine, where the next instruction to be executed is a
read of thread @{term i}: @{term "Read⇩s⇩b volatile a t"}. The configuration of the virtual machine is @{term "cfg=(ts,m,𝒮)"}.
We have to simulate this step on the virtual machine and can make use of
the coupling relations @{term "(ts⇩s⇩b⇩h,m⇩s⇩b⇩h,𝒮⇩s⇩b⇩h) ∼ (ts,m,𝒮)"}, the invariants @{term "invariant ts⇩s⇩b⇩h 𝒮⇩s⇩b⇩h m⇩s⇩b⇩h"} and the safety of all reachable states of the virtual machine: @{term "safe_reach_direct_delayed (ts,m,𝒮)"}. The state of the store buffer machine and the coupling with the volatile machine is depicted in Figure~\ref{fig:coupling-i-read}. Note that if there are some suspended instructions in thread @{term i}, we cannot directly exploit the 'safety of the read', as the virtual machine has not yet reached the state where thread @{term i} is poised to do the read. But fortunately we have safety of the virtual machien of all reachable states. Hence we can just execute all suspended instructions of thread @{term i} until we reach the read. We refer to this configuration of the virtual machine as @{term "cfg''=(ts'',m'',𝒮'')"}, which is depicted in Figure~\ref{fig:coupling-i-read-forward}.
\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered, outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]
\tikzstyle{virtual}=[dotted]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};
\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Read⇩s⇩b volatile a t"},$\dots$};
\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};
\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};
\path (sbr1.north east) to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east) to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east) to node [near end,left] {$\vdots$} (sbr2.south east);
\node (sblabel)[above] at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above] at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};
%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners] (memNorthWest) rectangle (memSouthEast) node [midway] {@{term "m⇩s⇩b⇩h"}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north west) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south west);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);
\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
to ($ (sbr3.south west)$);
\node (execslabel)[below] at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below] at ($ (sbr3.south)$) {suspended};
\end{tikzpicture}
\caption{Thread @{term i} poised to read \label{fig:coupling-i-read}}
\end{figure}
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered, outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]%todo rename to executed?
\tikzstyle{virtual}=[dotted]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};
\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,style=nonvolatile,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Read⇩s⇩b volatile a t"},$\dots$};
\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {nv};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};
\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};
\path (sbr1.north east) to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east) to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east) to node [near end,left] {$\vdots$} (sbr2.south east);
\node (sblabel)[above] at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above] at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};
%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners] (memNorthWest) rectangle (memSouthEast) node [midway] {@{term "m⇩s⇩b⇩h"}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north east) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south east);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);
\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
to ($ (sbr3.south west)$);
\node (execslabel)[below] at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below] at ($ (sbr3.south)$) {suspended};
\end{tikzpicture}
\caption{Forwarded computation of virtual machine \label{fig:coupling-i-read-forward}}
\end{figure}
For now we want to consider the case where the read goes to memory and is not forwarded from the store buffer. The value read is @{term "v=m⇩s⇩b⇩h a"}. Moreover, we make a case distinction wheter there is an outstanding volatile write in the store buffer of thread @{term i} or not. This determines if there are suspended instructions in the virtual machine or not. We start with the case where there is no such write. This means that there are no suspended instructions in thread @{term i} and therefore @{term "cfg''=cfg"}.
We have to show that the virtual machine reads the same value from memory: @{term "v = m a"}. So what can go wrong? When can the the memory of the virtual machine hold a different value? The memory of the virtual machine is obtained from the memory of the store buffer machine by executing all store buffers until we hit the first volatile write. So if there is a discrepancy in the value this has to come from a non-volatile write in the executed parts of another thread, let us say thread @{term j}. This write is marked as x in Figure~\ref{fig:coupling-i-read-conflict}.
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\begin{figure}
\centering
\begin{tikzpicture}
\tikzstyle{sbnodel}=[shape=rectangle, draw=black, text badly centered, outer sep=0cm]
\tikzstyle{sbnoder}=[shape=rectangle, draw=black, text ragged, outer sep=0cm]
\tikzstyle{nonvolatile}=[fill=gray!10]%todo rename to executed?
\tikzstyle{virtual}=[dotted]
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Store buffers and instructions %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\node (sbl0) [style=sbnodel,style=nonvolatile,text width=1.3cm] {nv};
\node (sbr0) [style=sbnoder,text width=1.7cm, right] at(sbl0.east) {v};
\node (ins0) [right] at ($ (sbr0.east) $) {thread $0$: $i_0^0$, $i_0^1$, $\dots$};
\node (sbl1) [style=sbnodel,style=nonvolatile,text width=2.0cm,below right] at ($ (sbl0.south west) -(0,0.6cm) $) {nv};
\node (sbr1) [style=sbnoder,style=nonvolatile,text width=1.0cm, right] at(sbl1.east) {v};
\node (ins1) [right] at ($ (sbr1.east) $) {thread $i$: @{term "Read⇩s⇩b volatile a t"},$\dots$};
\node (sbl2) [style=sbnodel,style=nonvolatile,text width=1.7cm,below right] at ($ (sbl1.south west) -(0,0.6cm) $) {x};
\node (sbr2) [style=sbnoder,text width=1.3cm, right] at(sbl2.east) {v};
\node (ins2) [right] at ($ (sbr2.east) $) {thread $j$: $i_j^0$, $i_j^1$, $\dots$};
\node (sbl3) [style=sbnodel,style=nonvolatile,text width=1.4cm,below right] at ($ (sbl2.south west) -(0,0.6cm) $) {nv};
\node (sbr3) [style=sbnoder,text width=1.6cm, right] at(sbl3.east) {v};
\node (ins3) [right] at ($ (sbr3.east) $) {thread $n$: $i_n^0$, $i_n^1$, $\dots$};
\path (sbr1.north east) to node [near end,left] {$\vdots$} (sbr0.south east);
\path (sbr2.north east) to node [near end,left] {$\vdots$} (sbr1.south east);
\path (sbr3.north east) to node [near end,left] {$\vdots$} (sbr2.south east);
\node (sblabel)[above] at ($ (sbr0.north west) +(0,0.6cm)$) {$\leftarrow$ store buffers};
\node (inslabel)[above] at ($ (sbr0.north east) +(1.5cm,0.6cm)$) {$\leftarrow$ instructions};
%%%%%%%%%%
% Memory %
%%%%%%%%%%
\coordinate (memNorthWest) at ($ (sbl0.north west) -(2.0cm,0cm) $);
\coordinate (memSouthEast) at ($ (sbl3.south west) -(0.5cm,0cm) $);
\filldraw[style=nonvolatile,rounded corners] (memNorthWest) rectangle (memSouthEast) node [midway] {@{term "m⇩s⇩b⇩h"}};
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% Virtual memory boundaries %
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
\draw [style=virtual,out=90,in=-90](sbr1.north east) to (sbr0.south west);
\draw [style=virtual,out=90,in=-90](sbr2.north west) to (sbr1.south east);
\draw [style=virtual,out=90,in=-90](sbr3.north west) to (sbr2.south west);
\draw [style=virtual] ($ (memNorthWest) +(0,0.4cm) $) to ($ (sbr0.north west) + (-0.3,0.4)$)[out=0,in=90] to ($ (sbr0.north west)$);
\draw [style=virtual]($ (memNorthWest |- memSouthEast) +(0,-0.8cm) $) to node[midway,above]{@{term m}} ($ (sbr3.south west) + (-0.3,-0.8)$)[out=0,in=90]
to ($ (sbr3.south west)$);
\node (execslabel)[below] at ($ (sbl3.south)$) {executed};
\node (suspendslabel)[below] at ($ (sbr3.south)$) {suspended};
\end{tikzpicture}
\caption{Conflicting write in thread j (marked x) \label{fig:coupling-i-read-conflict}}
\end{figure}
We refer to x both for the write operation itself and to characterize the point in time in the computation of the virtual machine where the write was executed. At the point x the write was safe according to rules in Figure~\ref{fig:safe-delayed} for non-volatile writes. So it was owned by thread @{term j} and unshared. This knowledge about the safety of write x is preserved in the invariants, namely (Ownership.\ref{inv-ownership:owned-or-read-only})
and (Sharing.\ref{inv-sharing:non-volatile-writes-unshared}). Additionally from invariant (Sharing.\ref{inv-sharing:no-write-to-read-only-memory}) we know that address @{term a} was not read-only at point x. Now we combine this information with the safety of the read of thread @{term i} in the current configuration @{term "cfg"}: address @{term a} either has to be owned by thread @{term i}, or has to be read-only or the read is volatile and @{term a} is shared. Additionally there are the constraints on the released addresses which we will exploit below. Let us address all cases step by step.
First, we consider that address @{term a} is currently owned by thread @{term i}. As it was owned by thread @{term j} at time x there has to be an release of @{term a} in the executed prefix of the store buffer of thread @{term j}. This release is recorded in the release set,
so we know @{term "a ∈ dom (ℛs!j)"}. This contradicts the safety of the read. Second, we consider that address @{term a} is currently read-only.
At time x address @{term a} was owned by thread @{term j}, unshared and not read-only. Hence there was a release of address @{term a} in the executed prefix of the store buffer of @{term j}, where it made a transition unshared and owned to shared. With the monotonicity of the release sets this means
@{term "a ∈ dom (ℛs!j)"}, even more precisely @{term "(ℛs!j) a = Some False"}. Hence there is no chance to get the read safe (neiter a volatile nor a non-volatile). Third, consider a volatile read and that address @{term a} is currently shared. This is ruled out by the same line of reasoning as in the previous case.
So ultimately we have ruled out all races that could destroy the value at address @{term a} and have shown that we can simulate the step on the virtual machine.
This completes the simulation of the case where there is no store buffer forwarding and no volatile write in the store buffer of thread @{term i}. The other cases are handled similar. The main arguments are obtained by arguing about safety of configuration @{term cfg''} and exploiting the invariants to rule out conflicting operations in other store buffers. When there is a volatile write in he store buffer of thread @{term i} there are still pending suspended instructions in the virtual machine. Hence the virtual machine makes no step and we have to argue that the simulation relation as well as all invariants still hold.
Up to now we have focused on how to simulate the read and in particular on how to argue that the value read in the store buffer machine is the same as the value read in the virtual machine. Besided these simulation properties another major part of the proof is to show that all invariants are maintained. For example if the non-volatile read enters the store buffer we have to argue that this new entry is either owned or refers to an read-only address (Ownership.\ref{inv-ownership:owned-or-read-only}). As for the simulation above this follows from safety of the virtual machine in configuration @{term "cfg''"}. However, consider an ghost operation that acquires an address @{term a}. From safety of the configuration @{term "cfg''"} we can only infer that there is no conflicting acquire in the non-volaitle prefixes of the other store buffers. In case an conflicting acquire is in the suspended part of a store buffer of thread @{term j} safety of configuration @{term "cfg''"} is not enough. But as we have safety of all reachable states we can forward the computation of thread @{term j} until the conflicting acquire is about to be executed and construct an unsafe state which rules out the conflict.
Last we want to comment on the case where the store buffer takes a step. The major case destinction is wheter a volatile write leaves the store buffer or not. In the former case the virtual machine has to simulate a whole bunch of instructions at once to simulate the store buffer machine up to the next volatile write in the store buffer. In the latter case the virtual machine does no step at all, since the instruction leaving the store buffer is already simulated. In both cases one key argument is commutativity of non-volatile operations with respect to global effects on the memory or the sharing map. Consider a non-volatile store buffer step of thread @{term i}. In the configuration of the virtual machine before the store buffer step of thread @{term i}, the simulation relation applies the update to the memory and the sharing map of the store buffer machine, within the operations @{term "flush_all_until_volatile_write"} and @{term "share_all_until_volatile_write"} `somewhere in the middle' to obtain the memory and the sharing map of the virtual machine. After the store buffer step however, when the non-volatile operations has left the store buffer, the effect is applied to the memory and the sharing map right in the beginning. The invariants and safety sideconditions for non-volatile operations guarantee `locality' of the operation which manifests in commutativity properties. For example, a non-volatile write is thread local. There is no conflicting write in any other store buffer and hence the write can be safely moved to the beginning.
This conludes the discussion on the proof of Theorem~\ref{thm:simulation}.\qed
›
text (in xvalid_program_progress) ‹
\bigskip
The simulation theorem for a single step is inductive and can therefor be extended to arbitrary long computations.
Moreover, the coupling relation as well as the invariants become trivial for a initial configuration where all store buffers are empty and the ghost state is setup appropriately. To arrive at our final Theorem \ref{thm:reduction} we need the following steps:
\begin{enumerate}
\item \label{sim:sb-sbh} simulate the computation of the store buffer machine @{term "(ts⇩s⇩b,m,()) ⇒⇩s⇩b⇧* (ts⇩s⇩b',m',())"} by a computation of a store buffer machine with history @{term "(ts⇩s⇩b⇩h,m,𝒮) ⇒⇩s⇩b⇩h⇧* (ts⇩s⇩b⇩h',m',𝒮')"},
\item \label{sim:sbh-delayed} simulate the computation of the store buffer machine with history by a computation of the virtual machine
with delayed releases @{term "(ts,m,𝒮) ⇒⇩d⇧* (ts',m',𝒮')"} by Theorem \ref{thm:simulation} (extended to the reflexive transitive closure),
\item \label{sim:delayed-free-flowing} simulate the computation of the virtual machine with delayed releases by a computation of the virtual machine with free flowing releases @{term "(ts,m,𝒮) ⇒⇩v⇧* (ts',m',𝒮')"}\footnote{Here we are sloppy with @{term ts}; strictly we would have to distinguish the thread configurations without the @{term ℛ} component form the ones with the @{term ℛ} component used for delayed releases}.
\end{enumerate}
Step \ref{sim:sb-sbh} is trivial since the bookkeeping within the additional ghost and history state does not affect the control flow of the transition systems and can be easily removed. Similar the additional @{term ℛ} ghost component can be ignored in Step \ref{sim:delayed-free-flowing}. However, to apply Theorem \ref{thm:simulation} in Step \ref{sim:sbh-delayed} we have to convert from @{term [names_short] "safe_reach_virtual_free_flowing (ts, m, 𝒮)"} provided by the preconditions of Theorem \ref{thm:reduction} to the required @{term [names_short] "safe_reach_direct_delayed (ts, m, 𝒮)"}. This argument is more involved and we only give a short sketch here.
The other direction is trivial as every single case for delayed releases (cf. Figure \ref{fig:safe-delayed}) immediately implies the corresponding case for free flowing releases (cf. Figure \ref{fig:safe-virtual-memory}).
First keep in mind that the predicates ensure that \emph{all} reachable configurations starting from @{term "(ts,m,𝒮)"} are safe, according to the rules for free flowing releases or delayed releases respectively. We show the theorem by contraposition and start with a computation which reaches a configuration @{term c} that is unsafe according to the rules for delayed releases and want to show that there has to be a (potentially other) computation (starting from the same initial state) that leads to an unsafe configuration @{term c'} accroding to free flowing releases.
If @{term c} is already unsafe according to free flowing releases we have @{term "c'=c"} and are finished.
Otherwise we have to find another unsafe configuration.
Via induction on the length of the global computation we can also assume that for all shorter computations both safety notions coincide.
A configuration can only be unsafe with respect to delayed releases and safe with respect to free flowing releases if there is a race between two distinct Threads @{term i} and @{term j} on an address @{term a} that is in the release set @{term "ℛ"} of one of the threads, lets say Thread @{term i}.
For example Thread @{term j} attempts to write to an address @{term a} which is in the release set of Thread @{term i}.
If the release map would be empty there cannot be such an race (it would simulataneously be unsafe with respect to free flowing releases).
Now we aim to find a configuration @{term c'} that is also reachable from the initial configuration and is unsafe with respect to free flowing releases.
Intuitively this is a configuration where Thread @{term i} is rewinded to the state just before the release of address @{term a} and Thread @{term j} is in the same state as in configuration @{term c}.
Before the release of @{term a} the address has to be owned by Thread @{term i}, which is unsafe according to free flowing releases as well as delayed releases.
So we can argue that either Thread @{term j} can reach the same state although Thread @{term i} is rewinded or we even hit an unsafe configuration before.
What kind of steps can Thread @{term i} perform between between the free flowing release point (point of the ghost instruction) and the delayed release point (point of next volatile write, interlocked operation or fence at which the release map is emptied)? How can these actions affect Thread @{term j}?
Note that the delayed release point is not yet reached as this would empty the release map (which we know not to be empty).
Thus Thread @{term i} does only perform reads, ghost instructions, program steps or non-volatile writes.
All of these instructions of Thread @{term i} either have no influence on the computation of Thread @{term j} at all (e.g. a read, program step, non-volatile write or irrelevant ghost operation) or may cause a safety violation already in a shorter computation (e.g. acquiring an address that another thread holds). This is fine for our inductive argument. So either we can replay every step of Thread @{term j} and reach
the final configuration @{term c'} which is now also unsafe according to free flowing releases, or we hit a configuration @{term c''} in a shorter computation which violates the rules of delayed as well as free flowing releases (using the induction hypothesis).
›
section ‹PIMP \label{sec:pimp}›
text ‹
PIMP is a parallel version of IMP\cite{Nipkow-FSTTCS-96}, a canonical WHILE-language.
An expression @{term "e"} is either
\begin{inparaenum}
\item @{term "Const v"}, a constant value,
\item @{term "Mem volatile a"}, a (volatile) memory lookup at address @{term "a"},
\item @{term "Tmp sop"}, reading from the temporaries with a operation @{term "sop"} which is an intermediate expression occurring in the transition rules for statements,
\item @{term "Unop f e"}, a unary operation where @{term "f"} is a unary function on values, and finally
\item @{term "Binop f e⇩1 e⇩2"}, a binary operation where @{term "f"} is a binary function on values.
\end{inparaenum}
A statement @{term "s"} is either
\begin{inparaenum}
\item @{term "Skip"}, the empty statement,
\item @{term "Assign volatile a e A L R W"}, a (volatile) assignment of expression @{term "e"} to address expression @{term "a"},
\item @{term "CAS a c⇩e s⇩e A L R W"}, atomic compare and swap at address expression @{term "a"} with compare expression
@{term "c⇩e"} and swap expression @{term "s⇩e"},
\item @{term "Seq s⇩1 s⇩2"}, sequential composition,
\item @{term "Cond e s⇩1 s⇩2"}, the if-then-else statement,
\item @{term "While e s"}, the loop statement with condition @{term "e"},
\item @{term "SGhost"}, and @{term "SFence"} as stubs for the corresponding memory instructions.
\end{inparaenum}
The key idea of the semantics is the following: expressions are evaluated by issuing instructions to the memory system, then the program waits until the memory system has made all necessary results available in the temporaries, which allows the program to make another step. Figure~\ref{fig:expression-evaluation} defines expression evaluation.
%
\begin{figure}
\begin{tabularx}{\textwidth}{l@ {~~‹=›~~}X}
@{thm (lhs) issue_expr.simps (1) [no_vars]} & @{thm (rhs) issue_expr.simps (1) [no_vars]}\\
@{thm (lhs) issue_expr.simps (2) [no_vars]} & @{thm (rhs) issue_expr.simps (2) [no_vars]}\\
@{thm (lhs) issue_expr.simps (3) [where sop="(D,f)", no_vars]} & @{thm (rhs) issue_expr.simps (3) [where sop="(D,f)", no_vars]}\\
@{thm (lhs) issue_expr.simps (4) [no_vars]} & @{thm (rhs) issue_expr.simps (4) [no_vars]}\\
@{thm (lhs) issue_expr.simps (5) [no_vars]} & @{thm [break,margin=50] (rhs) issue_expr.simps (5) [no_vars]}\\
\end{tabularx}\\[2pt]
\begin{tabularx}{\textwidth}{l@ {~~‹=›~~}X}
@{thm (lhs) eval_expr.simps (1) [no_vars]} & @{thm (rhs) eval_expr.simps (1) [no_vars]}\\
@{thm (lhs) eval_expr.simps (2) [no_vars]} & @{thm (rhs) eval_expr.simps (2) [no_vars]}\\
@{thm (lhs) eval_expr.simps (3) [where sop="(D,f)", no_vars]} & @{thm (rhs) eval_expr.simps (3) [where sop="(D,f)",simplified fst_conv snd_conv, no_vars]}\\
@{thm (lhs) eval_expr.simps (4) [no_vars]} & @{thm (rhs) eval_expr.simps (4) [no_vars]}\\
@{thm (lhs) eval_expr.simps (5) [no_vars]} & @{thm [break,margin=50] (rhs) eval_expr.simps (5) [no_vars]}
\end{tabularx}
\caption{Expression evaluation\label{fig:expression-evaluation}}
\end{figure}
%
The function @{term "used_tmps e"} calculates the number of temporaries that are necessary to evaluate expression @{term "e"}, where every @{term "Mem"} expression accounts to one temporary.
With @{term "issue_expr t e"} we obtain the instruction list for expression @{term "e"} starting at temporary @{term "t"}, whereas @{term "eval_expr t e"} constructs the operation as a pair of the domain and a function on the temporaries.
The program transitions are defined in Figure~\ref{fig:program-transitions}. We instantiate the program state by a tuple @{term "(s,t)"} containing the statement @{term "s"} and the temporary counter @{term "t"}.
%
\begin{figure}
\begin{center}
@{thm [mode=Rule] AssignAddr' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] Assign' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CASAddr' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CASComp' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] CAS' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.Seq [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] stmt_step.SeqSkip [no_vars]} \\[0.5\baselineskip]
@{thm [mode=Rule] SCond' [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.CondTrue [no_vars]}\\[0.5\baselineskip]
@{thm [mode=Rule] stmt_step.CondFalse [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] While [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SGhost [no_vars]}\\[-0.3\baselineskip]
@{thm [mode=Axiom] SFence [no_vars]}\\[0.1\baselineskip]
\end{center}
\caption{Program transitions\label{fig:program-transitions}}
\end{figure}
%
To assign an expression @{term "e"} to an address(-expression) @{term "a"} we first create the memory instructions for evaluation the address @{term "a"} and transforming the expression to an operation on temporaries. The temporary counter is incremented accordingly.
When the value is available in the temporaries we continue by
creating the memory instructions for evaluation of expression @{term "e"} followed by the corresponding store operation.
Note that the ownership annotations can depend on the temporaries and thus can take the calculated address into account.
Execution of compare and swap @{term "CAS"} involves evaluation of three expressions, the address @{term "a"} the compare value @{term "c⇩e"} and the swap value @{term "s⇩e"}.
It is finally mapped to the read-modify-write instruction @{term "RMW"} of the memory system.
Recall that execution of @{term "RMW"} first stores the memory content at address @{term "a"} to the specified temporary.
The condition compares this value with the result of evaluating @{term "c⇩e"} and writes swap value @{term "s⇩a"} if successful.
In either case the temporary finally returns the old value read.
Sequential composition is straightforward. An if-then-else is computed by first issuing the memory instructions for evaluation of condition @{term "e"} and transforming the condition to an operation on temporaries.
When the result is available the transition to the first or second statement is made, depending on the result of @{const "isTrue"}.
Execution of the loop is defined by stepwise unfolding.
Ghost and fence statements are just propagated to the memory system.
%
To instantiate Theorem~\ref{thm:simulation} with PIMP we define the invariant parameter @{term "valid"}, which has to be maintained by all transitions of PIMP, the memory system and the store buffer.
Let @{term "θ"} be the valuation of temporaries in the current configuration, for every thread configuration @{term "ts⇩s⇩b!i = ((s,t),is,θ,sb,𝒟,𝒪)"} where @{term "i < length ts⇩s⇩b"} we require:
%
\begin{inparaenum}
\item The domain of all intermediate @{term "Tmp (D,f)"} expressions in statement @{term "s"} is below counter @{term "t"}.
\item All temporaries in the memory system including the store buffer are below counter @{term "t"}.
\item All temporaries less than counter @{term "t"} are either already defined in the temporaries @{term "θ"} or are outstanding read temporaries in the memory system.
\end{inparaenum}
For the PIMP transitions we prove these invariants by rule induction on the semantics.
For the memory system (including the store buffer steps) the invariants are straightforward.
The memory system does not alter the program state and does not create new temporaries, only the PIMP transitions create new ones in strictly ascending order.
›
end
Theory Preliminaries
theory Preliminaries
imports Abbrevs
begin
record foorecord = fld⇩1 :: nat fld⇩2 ::nat
datatype foodatatype = Foo
notation (latex output)
Foo ("\<^latex>‹\\constructor{Foo}›")
section ‹Preliminaries \label{sec:preliminaries}›
text ‹
The formalization presented in this papaer is mechanized and checked within the generic interactive theorem prover \emph{Isabelle}\cite{Paulson:IGTP94}.
Isabelle is called generic as it provides a framework to formalize various \emph{object logics} declared via natural deduction style inference rules.
The object logic that we employ for our formalization is the higher order logic of \emph{Isabelle/HOL}\cite{Nipkow:IHOL02}.
This article is written using Isabelle's document generation facilities, which guarantees a close correspondence between the presentation and the actual theory files.
We distinguish formal entities typographically from other text.
We use a sans serif font for types and constants (including functions and predicates), \eg @{term "map"}, a slanted serif font for free variables, \eg @{term "x"}, and a slanted sans serif font for bound variables, \eg @{term "Bind x. x"}.
Small capitals are used for data type constructors, \eg @{term[names_short] "Foo"}, and type variables have a leading tick, \eg @{typ "'a"}. HOL keywords are typeset in type-writer font, \eg \holkeyword{let}. %We also take the freedom to borrow C notation, \eg @{term "UnsgndT"} when presenting C0.
To group common premises and to support modular reasoning Isabelle provides \emph{locales}\cite{Ballarin:TYPES03-34,Ballarin:MKM06-31}.
A locale provides a name for a context of fixed parameters and premises, together with an elaborate infrastructure to define new locales by inheriting and extending other locales, prove theorems within locales and interpret (instantiate) locales. In our formalization we employ this infrastructure to separate the memory system from the programming language semantics.
The logical and mathematical notions follow the standard notational conventions with a bias towards functional programming.
We only present the more unconventional parts here.
We prefer curried function application, \eg @{term "f a b"} instead of @{term [mode=uncurry] "f a b"}.
In this setting the latter becomes a function application to \emph{one} argument, which happens to be a pair.
Isabelle/HOL provides a library of standard types like Booleans, natural numbers, integers, total functions, pairs, lists, and sets. Moreover, there are packages to define new data types and records.
Isabelle allows polymorphic types, \eg @{typ "'a list"} is the list type with type variable @{typ "'a"}.
In HOL all functions are total, \eg @{typ "nat ⇒ nat"} is a total function on natural numbers.
A function update is @{thm fun_upd_def[of f y v]}.
To formalize partial functions the type @{typ "'a option"} is used.
It is a data type with two constructors, one to inject values of the base type, \eg @{term "Some x"}, and the additional element @{term "None"}.
A base value can be projected with the function @{term "the"}, which is defined by the sole equation @{thm option.sel [of x]}.
Since HOL is a total logic the term @{term "the None"} is still a well-defined yet un(der)specified value.
Partial functions are usually represented by the type ‹\<^latex>‹\tfreeify{›'a\<^latex>‹}› ⇒ \<^latex>‹\tfreeify{›'b\<^latex>‹}› option›, abbreviated as @{typ "'a ⇀ 'b"}.
They are commonly used as \emph{maps}.
%With @{term "map_of xs"} we construct a map from an association list, \ie a list of key~/~value pairs.
We denote the domain of map @{term "m"} by @{term "dom m"}. % not used: and to its range by @{term "ran m"}.
A map update is written as @{term "m(a := Some v)"}.
%With @{term "m⇩1 ++ m⇩2"} we add the map @{term "m⇩2"} to map @{term "m⇩1"}, where entries of @{term "m⇩1"} are overwritten if necessary.
We can restrict the domain of a map @{term "m"} to a set @{term "A"} by @{term "m |` A"}.
%Subsumption of maps is defined as @{thm "map_le_def" [of m⇩1 m⇩2]} and composition of maps as @{thm "map_comp_def" [of m⇩1 m⇩2]}.
%\paragraph{Lists.}
The syntax and the operations for lists are similar to functional programming languages like ML or Haskell.
The empty list is @{term "[]"}, with @{term "x#xs"} the element @{term "x"} is `consed' to the list @{term "xs"}.%, the head of list @{term "xs"} is @{term "hd xs"} and the remainder, its tail, is @{term "tl xs"}.
With @{term "xs@ys"} list @{term "ys"} is appended to list @{term "xs"}.
With the term @{term "map f xs"} the function @{term "f"} is applied to all elements in @{term "xs"}.
The length of a list is @{term "length xs"}, the @{term n}-th element of a list can be selected with @{term "xs!n"} and can be updated via @{term "xs[n:=v]"}. With @{term "dropWhile P xs"} the prefix for which all elements satisfy predicate @{term "P"} are dropped from list @{term "xs"}.
%With @{term "set xs"} we obtain the set of elements in list @{term "xs"}.
%Filtering those elements from a list for which predicate @{term "P"} holds is achieved by @{term [eta_contract=false] "[x∈xs. P x]"}.
%With @{term "replicate n e"} we denote a list that consists of @{term n} elements @{term e}.
%\paragraph{Sets.}
Sets come along with the standard operations like union, \ie @{term "A ∪ B"}, membership, \ie @{term "x ∈ A"} and set inversion, \ie @{term "- A"}.
%intersection, \ie @{term "A ∩ B"} and
%The set image @{term "f ` A"} yields a new set by applying function @{term "f"} to every element in set @{term "A"}.
%\paragraph{Records.}
%A record is constructed by assigning all of its fields, \eg @{term "⦇fld⇩1 = v⇩1, fld⇩2 = v⇩2⦈"}.
%Field @{term [names_short]"fld⇩1"} of record @{term "r"} is selected by @{term[names_short] "fld⇩1 r"} and updated with a value @{term "x"} via @{term[names_short] "r⦇fld⇩1 := x⦈"}.
%\paragraph{Tuples.}
%The first and second component of a pair can be accessed with the functions @{const fst} and @{const snd}.
Tuples with more than two components are pairs nested to the right.
›
end